Adapted to simplified VECTORISE pragmas
[packages/dph.git] / dph-lifted-vseg / Data / Array / Parallel / Prelude / Bool.hs
1 {-# OPTIONS_GHC -fvectorise #-}
2
3 module Data.Array.Parallel.Prelude.Bool
4 ( Bool(..)
5 , P.otherwise
6 , (P.&&), (P.||), P.not, andP, orP
7 , fromBool, toBool)
8 where
9 -- Primitives needed by the vectoriser.
10 import Data.Array.Parallel.Prim
11 import Data.Array.Parallel.PArr
12 import Data.Array.Parallel.Prelude.Base (Bool(..))
13 import Data.Array.Parallel.Prelude.Int as I (sumP, (==), (/=)) -- just temporary
14 import Data.Array.Parallel.Lifted (mapPP, lengthPP) -- just temporary
15 import Data.Array.Parallel.PArray.PRepr
16 import Data.Array.Parallel.PArray.PData.Base
17 import qualified Data.Array.Parallel.Unlifted as U
18 import Data.Bits
19 import qualified Prelude as P
20 import Prelude (Int)
21
22
23 -- and ------------------------------------------------------------------------
24 {-# VECTORISE (P.&&) = (&&*) #-}
25
26 (&&*) :: Bool :-> Bool :-> Bool
27 (&&*) = closure2 (P.&&) and_l
28 {-# INLINE (&&*) #-}
29 {-# NOVECTORISE (&&*) #-}
30
31 and_l :: PArray Bool -> PArray Bool -> PArray Bool
32 and_l (PArray n# bs) (PArray _ cs)
33 = PArray n# P.$
34 case bs of { PBool sel1 ->
35 case cs of { PBool sel2 ->
36 PBool P.$ U.tagsToSel2 (U.zipWith (.&.) (U.tagsSel2 sel1) (U.tagsSel2 sel2)) }}
37 {-# INLINE and_l #-}
38 {-# NOVECTORISE and_l #-}
39
40
41 -- or -------------------------------------------------------------------------
42 {-# VECTORISE (P.||) = (||*) #-}
43
44 (||*) :: Bool :-> Bool :-> Bool
45 (||*) = closure2 (P.||) or_l
46 {-# INLINE (||*) #-}
47 {-# NOVECTORISE (||*) #-}
48
49 or_l :: PArray Bool -> PArray Bool -> PArray Bool
50 or_l (PArray n# bs) (PArray _ cs)
51 = PArray n# P.$
52 case bs of { PBool sel1 ->
53 case cs of { PBool sel2 ->
54 PBool P.$ U.tagsToSel2 (U.zipWith (.|.) (U.tagsSel2 sel1) (U.tagsSel2 sel2)) }}
55 {-# INLINE or_l #-}
56 {-# NOVECTORISE or_l #-}
57
58
59 -- not ------------------------------------------------------------------------
60 {-# VECTORISE P.not = notPP #-}
61
62 notPP :: Bool :-> Bool
63 notPP = closure1 P.not notPP_l
64 {-# INLINE notPP #-}
65 {-# NOVECTORISE notPP #-}
66
67 notPP_l :: PArray Bool -> PArray Bool
68 notPP_l (PArray n# bs)
69 = PArray n# P.$
70 case bs of { PBool sel ->
71 PBool P.$ U.tagsToSel2 (U.map negate (U.tagsSel2 sel)) }
72 where
73 -- We must return 1 for True, 0 for False
74 negate i = (complement i) .&. 1
75 {-# NOVECTORISE notPP_l #-}
76 {-# INLINE notPP_l #-}
77
78
79 {- TODO: We can't do these because there is no Unboxes instance for Bool.
80 -- andP -----------------------------------------------------------------------
81 andP :: PArr Bool -> Bool
82 andP _ = True
83 {-# NOINLINE andP #-}
84 {-# VECTORISE andP = andPP #-}
85
86 andPP :: PArray Bool :-> Bool
87 andPP = L.closure1' (SC.fold (&&) True) (SC.folds (&&) True)
88 {-# INLINE andPP #-}
89 {-# NOVECTORISE andPP #-}
90
91
92 -- orP ------------------------------------------------------------------------
93 orP :: PArr Bool -> Bool
94 orP _ = True
95 {-# NOINLINE orP #-}
96 {-# VECTORISE orP = orPP #-}
97
98 orPP :: PArray Bool :-> Bool
99 orPP = L.closure1' (SC.fold (||) False) (SC.folds (||) False)
100 {-# INLINE orPP #-}
101 {-# NOVECTORISE orPP #-}
102 -}
103
104 -- Until we have Unboxes for Bool, we use the following definitions instead.
105
106 andP :: PArr Bool -> Bool
107 andP bs = I.sumP (mapP fromBool bs) I.== lengthP bs
108
109 orP :: PArr Bool -> Bool
110 orP bs = sumP (mapP fromBool bs) I./= 0
111
112 -- Defining 'mapP' and 'lengthP' here is just a kludge until the original definitions of
113 -- 'andP' and 'orP' work again.
114 mapP :: (a -> b) -> PArr a -> PArr b
115 mapP !_ !_ = emptyPArr
116 {-# NOINLINE mapP #-}
117 {-# VECTORISE mapP = mapPP #-}
118
119 lengthP :: PArr a -> Int
120 lengthP = lengthPArr
121 {-# NOINLINE lengthP #-}
122 {-# VECTORISE lengthP = lengthPP #-}
123
124
125 -- conversion functions --------------------------------------------------------
126
127 fromBool :: Bool -> Int
128 fromBool False = 0
129 fromBool True = 1
130
131 toBool :: Int -> Bool
132 toBool 0 = False
133 toBool _ = True