Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/9fff56c08b0305b2bf45a46ce8a71b5d1a1a3b3e >--------------------------------------------------------------- commit 9fff56c08b0305b2bf45a46ce8a71b5d1a1a3b3e Author: Manuel M T Chakravarty <[email protected]> Date: Sun Jan 15 22:12:19 2012 +1100 Adapt 'dph-classes' to class support in dph-lifted-vseg >--------------------------------------------------------------- tests/dph/classes/DefsVect.hs | 19 +++++-------------- 1 files changed, 5 insertions(+), 14 deletions(-) diff --git a/tests/dph/classes/DefsVect.hs b/tests/dph/classes/DefsVect.hs index a424acd..f6ed554 100644 --- a/tests/dph/classes/DefsVect.hs +++ b/tests/dph/classes/DefsVect.hs @@ -4,26 +4,12 @@ module DefsVect where import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Bool -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 #-} data MyBool = MyTrue | MyFalse @@ -31,6 +17,11 @@ data MyBool = MyTrue | MyFalse class Eq a => Cmp a where cmp :: a -> a -> Bool +-- FIXME: +-- instance Cmp Int where +-- cmp = (==) + +-- isFive :: (Eq a, Num a) => a -> Bool isFive :: Int -> Bool isFive x = x == 5 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
