summaryrefslogtreecommitdiff
path: root/compiler/vectorise
diff options
context:
space:
mode:
authorManuel M T Chakravarty <chak@cse.unsw.edu.au>2013-02-04 12:48:30 +1100
committerManuel M T Chakravarty <chak@cse.unsw.edu.au>2013-02-04 12:48:30 +1100
commitf940ec5cc73a941c1c9d0df5d3cf2c920ae8adb0 (patch)
tree0f58f4ee2b6ae2d9496ebcf494cdee870dae8fb9 /compiler/vectorise
parent82a30378475143438d9141b671ac0944333a836f (diff)
downloadhaskell-f940ec5cc73a941c1c9d0df5d3cf2c920ae8adb0.tar.gz
Vectoriser: PArray may be part of identity conversions
Diffstat (limited to 'compiler/vectorise')
-rw-r--r--compiler/vectorise/Vectorise/Builtins/Base.hs3
-rw-r--r--compiler/vectorise/Vectorise/Builtins/Initialise.hs8
-rw-r--r--compiler/vectorise/Vectorise/Convert.hs12
3 files changed, 16 insertions, 7 deletions
diff --git a/compiler/vectorise/Vectorise/Builtins/Base.hs b/compiler/vectorise/Vectorise/Builtins/Base.hs
index ca2e750845..4f07e6f8da 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 20c9f090d9..6770103d3b 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 f21f5cac86..bbd0c5a39b 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