module Data.Array.Parallel.PArray.Reference
( Similar(..), PprPhysical1 (..)
, withRef1, withRef2
, toRef1, toRef2, toRef3)
where
import Data.Array.Parallel.Pretty
import qualified Data.Array.Parallel.Array as A
import qualified Data.Vector as V
import Data.Vector (Vector)
import Prelude hiding (length)
import System.IO
import System.IO.Unsafe
import Control.Monad
debugLiftedTrace :: Bool
debugLiftedTrace = False
debugLiftedCompare :: Bool
debugLiftedCompare = False
class Similar a where
similar :: a -> a -> Bool
class PprPhysical1 a where
pprp1 :: a -> Doc
pprp1v :: Vector a -> Doc
pprp1v vec
= brackets
$ hcat
$ punctuate (text ", ")
$ V.toList $ V.map pprp1 vec
withRef1 :: ( A.Array r a
, A.Array c a, PprPhysical1 (c a)
, Similar a, PprPhysical1 a)
=> String
-> r a
-> c a
-> c a
withRef1 name arrRef arrImpl
= if debugLiftedCompare || debugLiftedTrace
then withRef1' name arrRef arrImpl
else arrImpl
withRef1' name arrRef arrImpl
= unsafePerformIO
$ do when debugLiftedTrace
$ do putStrLn $ "* " ++ name
putStrLn $ render (nest 4 $ pprp1 arrImpl)
hFlush stdout
when ( debugLiftedCompare
&& or [ not $ A.valid arrImpl
, not $ A.length arrRef == A.length arrImpl
, not $ V.and $ V.zipWith similar
(A.toVectors1 arrRef)
(A.toVectors1 arrImpl)])
$ error $ render $ vcat
[ text "withRef1: failure " <> text name
, nest 4 $ pprp1v $ A.toVectors1 arrRef
, nest 4 $ pprp1 $ arrImpl ]
return arrImpl
withRef2 :: ( A.Array r (r a)
, A.Array r a
, A.Array c (c a), PprPhysical1 (c (c a))
, A.Array c a, PprPhysical1 (c a)
, Similar a, PprPhysical1 a)
=> String
-> r (r a)
-> c (c a)
-> c (c a)
withRef2 name arrRef arrImpl
= if debugLiftedCompare || debugLiftedTrace
then withRef2' name arrRef arrImpl
else arrImpl
withRef2' name arrRef arrImpl
= unsafePerformIO
$ do when debugLiftedTrace
$ do putStrLn $ "* " ++ name
putStrLn $ render (nest 4 $ pprp1 arrImpl)
hFlush stdout
when ( debugLiftedCompare
&& or [ not $ A.valid arrImpl
, not $ A.length arrRef == A.length arrImpl
, not $ V.and $ V.zipWith
(\xs ys -> V.and $ V.zipWith similar xs ys)
(A.toVectors2 arrRef)
(A.toVectors2 arrImpl) ])
$ error $ render $ vcat
[ text "withRef2: failure " <> text name
, nest 4 $ pprp1 arrImpl ]
return arrImpl
toRef1 :: ( A.Array c a
, A.Array r a)
=> c a -> r a
toRef1 = A.fromVectors1 . A.toVectors1
toRef2 :: ( A.Array c (c a)
, A.Array c a
, A.Array r (r a)
, A.Array r a)
=> c (c a)
-> r (r a)
toRef2 = A.fromVectors2 . A.toVectors2
toRef3 :: ( A.Array c (c (c a))
, A.Array c (c a)
, A.Array c a
, A.Array r (r (r a))
, A.Array r (r a)
, A.Array r a)
=> c (c (c a))
-> r (r (r a))
toRef3 = A.fromVectors3 . A.toVectors3