Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/94ebbb083e9d10aa5298f6e59dbad24fb9f17c7a >--------------------------------------------------------------- commit 94ebbb083e9d10aa5298f6e59dbad24fb9f17c7a Author: Manuel M T Chakravarty <[email protected]> Date: Sun Dec 18 17:09:32 2011 +1100 Testing vectorisation of superclasses >--------------------------------------------------------------- .gitignore | 3 +- tests/dph/classes/DefsVect.hs | 22 ++++++++++++++----- ...py-fast.stdout => dph-classes-vseg-fast.stdout} | 0 tests/dph/classes/dph-classes.T | 7 ++--- 4 files changed, 21 insertions(+), 11 deletions(-) diff --git a/.gitignore b/.gitignore index b01b356..e5bb0bf 100644 --- a/.gitignore +++ b/.gitignore @@ -142,4 +142,5 @@ tests/dph/primespj/dph-primespj-copy-fast tests/dph/quickhull/dph-quickhull-copy-fast tests/dph/quickhull/dph-quickhull-vseg-fast tests/dph/words/dph-words-copy-fast -tests/dph/words/dph-words-vseg-fast \ No newline at end of file +tests/dph/words/dph-words-vseg-fast +tests/dph/classes/dph-classes-vseg-fast \ No newline at end of file diff --git a/tests/dph/classes/DefsVect.hs b/tests/dph/classes/DefsVect.hs index 883ad7b..a424acd 100644 --- a/tests/dph/classes/DefsVect.hs +++ b/tests/dph/classes/DefsVect.hs @@ -5,16 +5,26 @@ module DefsVect where import Data.Array.Parallel import Data.Array.Parallel.Prelude.Bool -import Data.Array.Parallel.Prelude.Int (Int) +import Data.Array.Parallel.Prelude.Int (Int, sumP) {-# VECTORISE class Eq #-} +{-# VECTORISE SCALAR instance Eq Bool #-} +-- {-# VECTORISE SCALAR instance Eq Char #-} {-# VECTORISE SCALAR instance Eq Int #-} +{-# VECTORISE SCALAR instance Eq Word8 #-} +-- {-# VECTORISE SCALAR instance Eq Float #-} +{-# VECTORISE SCALAR instance Eq Double #-} +{-# VECTORISE SCALAR instance Eq Ordering #-} +{-# VECTORISE class Ord #-} +{-# VECTORISE SCALAR instance Ord Bool #-} +-- {-# VECTORISE SCALAR instance Ord Char #-} +{-# VECTORISE SCALAR instance Ord Int #-} +{-# VECTORISE SCALAR instance Ord Word8 #-} +-- {-# VECTORISE SCALAR instance Ord Float #-} +{-# VECTORISE SCALAR instance Ord Double #-} +{-# VECTORISE SCALAR instance Ord Ordering #-} --- {-# VECTORISE class Ord #-} --- {-# VECTORISE SCALAR instance Ord Int #-} - --- {-# VECTORISE type Ordering #-} data MyBool = MyTrue | MyFalse @@ -49,4 +59,4 @@ isEqs :: PArray Int -> Bool isEqs xs = isEqs' (fromPArrayP xs) isEqs' :: [:Int:] -> Bool -isEqs' xs = andP (mapP isEq xs) \ No newline at end of file +isEqs' xs = andP (mapP isEq xs) diff --git a/tests/dph/classes/dph-classes-copy-fast.stdout b/tests/dph/classes/dph-classes-vseg-fast.stdout similarity index 100% copy from tests/dph/classes/dph-classes-copy-fast.stdout copy to tests/dph/classes/dph-classes-vseg-fast.stdout diff --git a/tests/dph/classes/dph-classes.T b/tests/dph/classes/dph-classes.T index 4928c20..425d6ab 100644 --- a/tests/dph/classes/dph-classes.T +++ b/tests/dph/classes/dph-classes.T @@ -1,10 +1,9 @@ -test ('dph-classes-copy-fast' +test ('dph-classes-vseg-fast' , [ alone , extra_clean(['Main.o', 'Main.hi', 'DefsVect.hi', 'DefsVect.o']) - , reqlib('dph-lifted-copy') + , reqlib('dph-lifted-vseg') , reqlib('dph-prim-par') , only_ways(['normal', 'threaded1', 'threaded2']) ] , multimod_compile_and_run , [ 'Main' - , '-O -fno-enable-rewrite-rules -package dph-lifted-copy']) - + , '-O -fno-enable-rewrite-rules -package dph-lifted-vseg']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
