dph-common/Data/Array/Parallel/Lifted/Instances.hs

   1 {-# LANGUAGE CPP #-}
   2
   3 #include "fusion-phases.h"
   4
   5 module Data.Array.Parallel.Lifted.Instances (
   6   PData(..),
   7
   8   dPA_Int, dPR_Int, {- upToPA_Int, -}
   9
  10   dPA_Word8, dPR_Word8,
  11   dPA_Double, dPR_Double,
  12
  13   dPA_Bool, {- toPrimArrPA_Bool, truesPA#, -}
  14   dPA_Unit, dPA_2, dPA_3, dPA_4, dPA_5,
  15   dPA_PArray
  16 ) where
  17
  18 import Data.Array.Parallel.Lifted.PArray
  19 import Data.Array.Parallel.Lifted.Repr
  20 import Data.Array.Parallel.Lifted.Unboxed ( elementsSegd# )
  21 import Data.Array.Parallel.Lifted.Selector
  22
  23 import qualified Data.Array.Parallel.Unlifted as U
  24
  25 import GHC.Exts    ( Int#, Int(..), (+#), (*#),
  26                      Double#, Double(..) )
  27 import GHC.Word    ( Word8(..) )
  28
  29 newtype instance PData Int = PInt (U.Array Int)
  30
  31 type instance PRepr Int = Int
  32
  33 dPA_Int :: PA Int
  34 {-# INLINE_PA dPA_Int #-}
  35 dPA_Int = PA {
  36             toPRepr      = id
  37           , fromPRepr    = id
  38           , toArrPRepr   = id
  39           , fromArrPRepr = id
  40           , dictPRepr    = dPR_Int
  41           }
  42
  43 dPR_Int :: PR Int
  44 {-# INLINE dPR_Int #-}
  45 dPR_Int = PR {
  46             emptyPR      = emptyPR_Int
  47           , replicatePR  = replicatePR_Int
  48           , replicatelPR = replicatelPR_Int
  49           , repeatPR     = repeatPR_Int
  50           , repeatcPR    = repeatcPR_Int
  51           , indexPR      = indexPR_Int
  52           , bpermutePR   = bpermutePR_Int
  53           , extractPR    = extractPR_Int
  54           , appPR        = appPR_Int
  55           , applPR       = applPR_Int
  56           , packPR       = packPR_Int
  57           , combine2PR   = combine2PR_Int
  58           , fromListPR   = fromListPR_Int
  59           , nfPR         = nfPR_Int
  60           }
  61
  62 {-# INLINE emptyPR_Int #-}
  63 emptyPR_Int = PInt U.empty
  64
  65 {-# INLINE replicatePR_Int #-}
  66 replicatePR_Int n# i = PInt (U.replicate (I# n#) i)
  67
  68 {-# INLINE replicatelPR_Int #-}
  69 replicatelPR_Int segd (PInt xs) = PInt (U.replicate_s segd xs)
  70
  71 {-# INLINE repeatPR_Int #-}
  72 repeatPR_Int n# len# (PInt xs) = PInt (U.repeat (I# n#) (I# len#) xs)
  73
  74 {-# INLINE repeatcPR_Int #-}
  75 repeatcPR_Int n# ns segd (PInt xs) = PInt (U.repeat_c (I# n#) ns segd xs)
  76
  77 {-# INLINE indexPR_Int #-}
  78 indexPR_Int (PInt xs) i# = xs U.!: I# i#
  79
  80 {-# INLINE extractPR_Int #-}
  81 extractPR_Int (PInt xs) i# n# = PInt (U.extract xs (I# i#) (I# n#))
  82
  83 bpermutePR_Int :: T_bpermutePR Int
  84 {-# INLINE bpermutePR_Int #-}
  85 bpermutePR_Int (PInt xs) _ is = PInt (U.bpermute xs is)
  86
  87 {-# INLINE appPR_Int #-}
  88 appPR_Int (PInt xs) (PInt ys) = PInt (xs U.+:+ ys)
  89
  90 {-# INLINE applPR_Int #-}
  91 applPR_Int xsegd (PInt xs) ysegd (PInt ys)
  92   = PInt (U.append_s xsegd xs ysegd ys)
  93
  94 packPR_Int :: T_packPR Int
  95 {-# INLINE packPR_Int #-}
  96 packPR_Int (PInt ns) n# bs = PInt (U.pack ns bs)
  97
  98 combine2PR_Int :: T_combine2PR Int
  99 {-# INLINE combine2PR_Int #-}
 100 combine2PR_Int n# sel (PInt xs) (PInt ys)
 101   = PInt (U.combine (U.pick (tagsSel2 sel) 0) xs ys)
 102
 103 fromListPR_Int :: T_fromListPR Int
 104 {-# INLINE fromListPR_Int #-}
 105 fromListPR_Int n# xs = PInt (U.fromList xs)
 106
 107 {-# INLINE nfPR_Int #-}
 108 nfPR_Int (PInt xs) = xs `seq` ()
 109
 110 {-
 111 upToPA_Int :: Int -> PArray Int
 112 {-# INLINE_PA upToPA_Int #-}
 113 upToPA_Int (I# n#) = PInt n# (upToPA_Int# n#)
 114 -}
 115
 116 newtype instance PData Word8 = PWord8 (U.Array Word8)
 117
 118 type instance PRepr Word8 = Word8
 119
 120 dPA_Word8 :: PA Word8
 121 {-# INLINE_PA dPA_Word8 #-}
 122 dPA_Word8 = PA {
 123             toPRepr      = id
 124           , fromPRepr    = id
 125           , toArrPRepr   = id
 126           , fromArrPRepr = id
 127           , dictPRepr    = dPR_Word8
 128           }
 129
 130 dPR_Word8 :: PR Word8
 131 {-# INLINE dPR_Word8 #-}
 132 dPR_Word8 = PR {
 133             emptyPR      = emptyPR_Word8
 134           , replicatePR  = replicatePR_Word8
 135           , replicatelPR = replicatelPR_Word8
 136           , repeatPR     = repeatPR_Word8
 137           , repeatcPR    = repeatcPR_Word8
 138           , indexPR      = indexPR_Word8
 139           , extractPR    = extractPR_Word8
 140           , bpermutePR   = bpermutePR_Word8
 141           , appPR        = appPR_Word8
 142           , applPR       = applPR_Word8
 143           , packPR       = packPR_Word8
 144           , combine2PR   = combine2PR_Word8
 145           , fromListPR   = fromListPR_Word8
 146           , nfPR         = nfPR_Word8
 147           }
 148
 149 {-# INLINE emptyPR_Word8 #-}
 150 emptyPR_Word8 = PWord8 U.empty
 151
 152 {-# INLINE replicatePR_Word8 #-}
 153 replicatePR_Word8 n# i = PWord8 (U.replicate (I# n#) i)
 154
 155 {-# INLINE replicatelPR_Word8 #-}
 156 replicatelPR_Word8 segd (PWord8 xs) = PWord8 (U.replicate_s segd xs)
 157
 158 {-# INLINE repeatPR_Word8 #-}
 159 repeatPR_Word8 n# len# (PWord8 xs) = PWord8 (U.repeat (I# n#) (I# len#) xs)
 160
 161 {-# INLINE repeatcPR_Word8 #-}
 162 repeatcPR_Word8 n# ns segd (PWord8 xs) = PWord8 (U.repeat_c (I# n#) ns segd xs)
 163
 164 {-# INLINE indexPR_Word8 #-}
 165 indexPR_Word8 (PWord8 xs) i# = xs U.!: I# i#
 166
 167 {-# INLINE extractPR_Word8 #-}
 168 extractPR_Word8 (PWord8 xs) i# n# = PWord8 (U.extract xs (I# i#) (I# n#))
 169
 170 bpermutePR_Word8 :: T_bpermutePR Word8
 171 {-# INLINE bpermutePR_Word8 #-}
 172 bpermutePR_Word8 (PWord8 xs) _ is = PWord8 (U.bpermute xs is)
 173
 174 {-# INLINE appPR_Word8 #-}
 175 appPR_Word8 (PWord8 xs) (PWord8 ys) = PWord8 (xs U.+:+ ys)
 176
 177 {-# INLINE applPR_Word8 #-}
 178 applPR_Word8 xsegd (PWord8 xs) ysegd (PWord8 ys)
 179   = PWord8 (U.append_s xsegd xs ysegd ys)
 180
 181 packPR_Word8 :: T_packPR Word8
 182 {-# INLINE packPR_Word8 #-}
 183 packPR_Word8 (PWord8 ns) n# bs = PWord8 (U.pack ns bs)
 184
 185 combine2PR_Word8 :: T_combine2PR Word8
 186 {-# INLINE combine2PR_Word8 #-}
 187 combine2PR_Word8 n# sel (PWord8 xs) (PWord8 ys)
 188   = PWord8 (U.combine (U.pick (tagsSel2 sel) 0) xs ys)
 189
 190 fromListPR_Word8 :: T_fromListPR Word8
 191 {-# INLINE fromListPR_Word8 #-}
 192 fromListPR_Word8 n# xs = PWord8 (U.fromList xs)
 193
 194 {-# INLINE nfPR_Word8 #-}
 195 nfPR_Word8 (PWord8 xs) = xs `seq` ()
 196
 197
 198 newtype instance PData Double = PDouble (U.Array Double)
 199
 200 type instance PRepr Double = Double
 201
 202 dPA_Double :: PA Double
 203 {-# INLINE_PA dPA_Double #-}
 204 dPA_Double = PA {
 205             toPRepr      = id
 206           , fromPRepr    = id
 207           , toArrPRepr   = id
 208           , fromArrPRepr = id
 209           , dictPRepr    = dPR_Double
 210           }
 211
 212 dPR_Double :: PR Double
 213 {-# INLINE dPR_Double #-}
 214 dPR_Double = PR {
 215             emptyPR      = emptyPR_Double
 216           , replicatePR  = replicatePR_Double
 217           , replicatelPR = replicatelPR_Double
 218           , repeatPR     = repeatPR_Double
 219           , repeatcPR    = repeatcPR_Double
 220           , indexPR      = indexPR_Double
 221           , extractPR    = extractPR_Double
 222           , bpermutePR   = bpermutePR_Double
 223           , appPR        = appPR_Double
 224           , applPR       = applPR_Double
 225           , packPR       = packPR_Double
 226           , combine2PR   = combine2PR_Double
 227           , fromListPR   = fromListPR_Double
 228           , nfPR         = nfPR_Double
 229           }
 230
 231 {-# INLINE emptyPR_Double #-}
 232 emptyPR_Double = PDouble U.empty
 233
 234 {-# INLINE replicatePR_Double #-}
 235 replicatePR_Double n# i = PDouble (U.replicate (I# n#) i)
 236
 237 {-# INLINE replicatelPR_Double #-}
 238 replicatelPR_Double segd (PDouble xs) = PDouble (U.replicate_s segd xs)
 239
 240 {-# INLINE repeatPR_Double #-}
 241 repeatPR_Double n# len# (PDouble xs) = PDouble (U.repeat (I# n#) (I# len#) xs)
 242
 243 {-# INLINE repeatcPR_Double #-}
 244 repeatcPR_Double n# ns segd (PDouble xs) = PDouble (U.repeat_c (I# n#) ns segd xs)
 245
 246 {-# INLINE indexPR_Double #-}
 247 indexPR_Double (PDouble xs) i# = xs U.!: I# i#
 248
 249 {-# INLINE extractPR_Double #-}
 250 extractPR_Double (PDouble xs) i# n# = PDouble (U.extract xs (I# i#) (I# n#))
 251
 252 bpermutePR_Double :: T_bpermutePR Double
 253 {-# INLINE bpermutePR_Double #-}
 254 bpermutePR_Double (PDouble xs) _ is = PDouble (U.bpermute xs is)
 255
 256 {-# INLINE appPR_Double #-}
 257 appPR_Double (PDouble xs) (PDouble ys) = PDouble (xs U.+:+ ys)
 258
 259 {-# INLINE applPR_Double #-}
 260 applPR_Double xsegd (PDouble xs) ysegd (PDouble ys)
 261   = PDouble (U.append_s xsegd xs ysegd ys)
 262
 263 packPR_Double :: T_packPR Double
 264 {-# INLINE packPR_Double #-}
 265 packPR_Double (PDouble ns) n# bs = PDouble (U.pack ns bs)
 266
 267 combine2PR_Double :: T_combine2PR Double
 268 {-# INLINE combine2PR_Double #-}
 269 combine2PR_Double n# sel (PDouble xs) (PDouble ys)
 270   = PDouble (U.combine (U.pick (tagsSel2 sel) 0) xs ys)
 271
 272 fromListPR_Double :: T_fromListPR Double
 273 {-# INLINE fromListPR_Double #-}
 274 fromListPR_Double n# xs = PDouble (U.fromList xs)
 275
 276 {-# INLINE nfPR_Double #-}
 277 nfPR_Double (PDouble xs) = xs `seq` ()
 278
 279
 280 data instance PData Bool
 281   = PBool Sel2
 282
 283 type instance PRepr Bool = Sum2 Void Void
 284
 285 dPA_Bool :: PA Bool
 286 {-# INLINE_PA dPA_Bool #-}
 287 dPA_Bool = PA {
 288              toPRepr      = toPRepr_Bool
 289            , fromPRepr    = fromPRepr_Bool
 290            , toArrPRepr   = toArrPRepr_Bool
 291            , fromArrPRepr = fromArrPRepr_Bool
 292            , dictPRepr    = dPR_Sum2 dPR_Void dPR_Void
 293            }
 294
 295 {-# INLINE toPRepr_Bool #-}
 296 toPRepr_Bool False = Alt2_1 void
 297 toPRepr_Bool True  = Alt2_2 void
 298
 299 {-# INLINE fromPRepr_Bool #-}
 300 fromPRepr_Bool (Alt2_1 _) = False
 301 fromPRepr_Bool (Alt2_2 _) = True
 302
 303 {-# INLINE toArrPRepr_Bool #-}
 304 toArrPRepr_Bool (PBool sel) = PSum2 sel pvoid pvoid
 305
 306 {-# INLINE fromArrPRepr_Bool #-}
 307 fromArrPRepr_Bool (PSum2 sel _ _) = PBool sel
 308
 309 {-
 310 toPrimArrPA_Bool :: PArray Bool -> U.Array Bool
 311 {-# INLINE toPrimArrPA_Bool #-}
 312 toPrimArrPA_Bool (PBool sel _ _ _ _ _) = U.pick sel 1
 313
 314 truesPA# :: PArray Bool -> Int#
 315 {-# INLINE_PA truesPA# #-}
 316 truesPA# (PBool _ _ _ fs ts) = lengthPA# dPA_Void ts
 317 -}
 318
 319 {-
 320 data instance PArray Bool = PBool Int# PArray_Int# PArray_Int#
 321
 322 type instance PRepr Bool = Enumeration
 323
 324 dPA_Bool :: PA Bool
 325 {-# INLINE_PA dPA_Bool #-}
 326 dPA_Bool = PA {
 327              toPRepr      = toPRepr_Bool
 328            , fromPRepr    = fromPRepr_Bool
 329            , toArrPRepr   = toArrPRepr_Bool
 330            , fromArrPRepr = fromArrPRepr_Bool
 331            , dictPRepr    = dPR_Enumeration
 332            }
 333
 334 {-# INLINE toPRepr_Bool #-}
 335 toPRepr_Bool False = Enumeration 0#
 336 toPRepr_Bool True  = Enumeration 1#
 337
 338 {-# INLINE fromPRepr_Bool #-}
 339 fromPRepr_Bool (Enumeration 0#) = False
 340 fromPRepr_Bool _                = True
 341
 342 {-# INLINE toArrPRepr_Bool #-}
 343 toArrPRepr_Bool (PBool n# sel# is#) = PEnum n# sel# is#
 344
 345 {-# INLINE fromArrPRepr_Bool #-}
 346 fromArrPRepr_Bool (PEnum n# sel# is#) = PBool n# sel# is#
 347 -}
 348
 349 -- Tuples
 350 --
 351 -- We can use one of the following two representations
 352 --
 353 -- data instance PArray (a1,...,an) = PTup<n> !Int (STup<n> (PArray a1)
 354 --                                                          ...
 355 --                                                          (PArray an))
 356 --
 357 -- where STup<n> are strict n-ary tuples or
 358 --
 359 -- data instance PArray (a1,...,an) = PTup<n> !Int (PArray a1) ... (PArray an)
 360 --
 361 -- Consider the following two terms:
 362 --
 363 --   xs = replicateP n (_|_, _|_)
 364 --   ys = replicateP n (_|_ :: (t,u))
 365 --
 366 -- These have to be represented differently; in particular, we have
 367 --
 368 --   xs !: 0 = (_|_,_|_)
 369 --   ys !: 0 = _|_
 370 --
 371 -- but
 372 --
 373 --   lengthP xs = lengthP ys = n
 374 --
 375 -- With he first representation, we have
 376 --
 377 --   xs = PTup2 n (STup2 (replicateP n _|_) (replicateP n _|_))
 378 --   ys = PTup2 n _|_
 379 --
 380 -- With
 381 --
 382 --   PTup2 n (STup2 xs ys) !: i = (xs !: i, ys !: i)
 383 --   lengthP (PTup2 n _)        = n
 384 --
 385 -- this gives use the desired result. With the second representation we might
 386 -- use:
 387 --
 388 --   replicateP n p = PArray n (p `seq` replicateP n x)
 389 --                             (p `seq` replicateP n y)
 390 --     where
 391 --       (x,y) = p
 392 --
 393 -- which gives us
 394 --
 395 --   xs = PTup2 n (replicateP n _|_) (replicateP n _|_)
 396 --   ys = PTup2 n _|_ _|_
 397 --
 398 -- We'd then have to use
 399 --
 400 --   PTup2 n xs ys !: i  = xs `seq` ys `seq` (xs !: i, ys !: i)
 401 --   lengthP (PTup2 n _) = n
 402 --
 403 -- Not sure which is better (the first seems slightly cleaner) but we'll go
 404 -- with the second repr for now as it makes closure environments slightly
 405 -- simpler to construct and to take apart.
 406
 407 {-
 408 data STup2 a b = STup2 !a !b
 409 data STup3 a b c = STup3 !a !b !c
 410 data STup4 a b c d = STup4 !a !b !c !d
 411 data STup5 a b c d e = STup5 !a !b !c !d !e
 412 -}
 413
 414 type instance PRepr () = ()
 415
 416 dPA_Unit :: PA ()
 417 {-# INLINE_PA dPA_Unit #-}
 418 dPA_Unit = PA {
 419              toPRepr      = id
 420            , fromPRepr    = id
 421            , toArrPRepr   = id
 422            , fromArrPRepr = id
 423            , dictPRepr    = dPR_Unit
 424            }
 425
 426 type instance PRepr (a,b) = (a,b)
 427
 428 dPA_2 :: PA a -> PA b -> PA (a,b)
 429 {-# INLINE_PA dPA_2 #-}
 430 dPA_2 pa pb = PA {
 431                 toPRepr      = id
 432               , fromPRepr    = id
 433               , toArrPRepr   = id
 434               , fromArrPRepr = id
 435               , dictPRepr    = dPR_2 (mkPR pa) (mkPR pb)
 436               }
 437
 438 type instance PRepr (a,b,c) = (a,b,c)
 439
 440 dPA_3 :: PA a -> PA b -> PA c -> PA (a,b,c)
 441 {-# INLINE_PA dPA_3 #-}
 442 dPA_3 pa pb pc
 443   = PA {
 444       toPRepr      = id
 445     , fromPRepr    = id
 446     , toArrPRepr   = id
 447     , fromArrPRepr = id
 448     , dictPRepr    = dPR_3 (mkPR pa) (mkPR pb) (mkPR pc)
 449     }
 450
 451 type instance PRepr (a,b,c,d) = (a,b,c,d)
 452
 453 dPA_4 :: PA a -> PA b -> PA c -> PA d -> PA (a,b,c,d)
 454 {-# INLINE_PA dPA_4 #-}
 455 dPA_4 pa pb pc pd
 456   = PA {
 457       toPRepr      = id
 458     , fromPRepr    = id
 459     , toArrPRepr   = id
 460     , fromArrPRepr = id
 461     , dictPRepr    = dPR_4 (mkPR pa) (mkPR pb) (mkPR pc) (mkPR pd)
 462     }
 463
 464 type instance PRepr (a,b,c,d,e) = (a,b,c,d,e)
 465
 466 dPA_5 :: PA a -> PA b -> PA c -> PA d -> PA e -> PA (a,b,c,d,e)
 467 {-# INLINE_PA dPA_5 #-}
 468 dPA_5 pa pb pc pd pe
 469   = PA {
 470       toPRepr      = id
 471     , fromPRepr    = id
 472     , toArrPRepr   = id
 473     , fromArrPRepr = id
 474     , dictPRepr    = dPR_5 (mkPR pa) (mkPR pb) (mkPR pc) (mkPR pd) (mkPR pe)
 475     }
 476
 477 type instance PRepr (PArray a) = PArray (PRepr a)
 478
 479 dPA_PArray :: PA a -> PA (PArray a)
 480 {-# INLINE_PA dPA_PArray #-}
 481 dPA_PArray pa
 482   = PA {
 483       toPRepr      = toPArrayPRepr pa
 484     , fromPRepr    = fromPArrayPRepr pa
 485     , toArrPRepr   = toNestedPRepr pa
 486     , fromArrPRepr = fromNestedPRepr pa
 487     , dictPRepr    = dPR_PArray (dictPRepr pa)
 488     }
 489
 490 {-# INLINE toPArrayPRepr #-}
 491 toPArrayPRepr pa (PArray n# xs) = PArray n# (toArrPRepr pa xs)
 492
 493 {-# INLINE fromPArrayPRepr #-}
 494 fromPArrayPRepr pa (PArray n# xs) = PArray n# (fromArrPRepr pa xs)
 495
 496 {-# INLINE toNestedPRepr #-}
 497 toNestedPRepr pa (PNested segd xs) = PNested segd (toArrPRepr pa xs)
 498
 499 {-# INLINE fromNestedPRepr #-}
 500 fromNestedPRepr pa (PNested segd xs) = PNested segd (fromArrPRepr pa xs)
 501