Commit fcbfdfee authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Merge branch 'master' of http://darcs.haskell.org/testsuite

parents eaae5f42 db6d9cd7
{-# LANGUAGE StandaloneDeriving, DeriveFunctor #-}
module T3057 where
deriving instance Functor (Either a)
import T3057A
deriving instance Functor (MyType a)
module T3057A where
data MyType a b = C1 a | C2 b
......@@ -18,7 +18,7 @@ test('drv021', normal, compile, [''])
test('deriving-1935', normal, compile, [''])
test('T2378', normal, compile, [''])
test('T2856', normal, compile, [''])
test('T3057', normal, compile, [''])
test('T3057', extra_clean(['T3057A.o', 'T3057A.hi']), multimod_compile, ['T3057', '-v0'])
test('T3012', normal, compile, [''])
test('T3965', normal, compile, [''])
test('T4220', normal, compile, [''])
......
......@@ -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
......
......@@ -3,7 +3,7 @@
module DiophantineVect (solution3) where
import Data.Array.Parallel
import Data.Array.Parallel.Prelude.Int
import Data.Array.Parallel.Prelude.Int as I
import qualified Prelude as P
......@@ -13,19 +13,19 @@ solution3'
primes = [: 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73 :]
a `cutTo` b = sliceP 0 (lengthP b) a
sumpri xx = productP [: pow p x | p <- primes `cutTo` xx | x <- xx :]
distinct xx = productP [: x + 1 | x <- xx :]
distinct xx = productP [: x I.+ 1 | x <- xx :]
series :: [:Int:] -> Int -> [:[:Int:]:]
series xs n
| n == 1 = [: [: 0 :] :]
| otherwise = [: [: x :] +:+ ps
| x <- xs
, ps <- series (enumFromToP 0 x) (n-1) :]
, ps <- series (I.enumFromToP 0 x) (n I.- 1) :]
prob x y
= let xx = [: (sumpri m ,m)
| m <- series (enumFromToP 1 3) x
, distinct [: x * 2 | x <- m :] > y :]
| m <- series (I.enumFromToP 1 3) x
, distinct [: x I.* 2 | x <- m :] > y :]
i = minIndexP [: a | (a, b) <- xx :]
in xx !: i
in
......
......@@ -12,4 +12,4 @@ dotp :: PArray Double -> PArray Double -> Double
dotp v w = dotp' (fromPArrayP v) (fromPArrayP w)
dotp' :: [:Double:] -> [:Double:] -> Double
dotp' v w = D.sumP (zipWithP (*) v w)
dotp' v w = D.sumP (zipWithP (D.*) v w)
......@@ -5,7 +5,7 @@ module Solver
where
import Data.Array.Parallel
import Data.Array.Parallel.Prelude.Bool
import Data.Array.Parallel.Prelude.Double
import Data.Array.Parallel.Prelude.Double as D
import qualified Data.Array.Parallel.Prelude.Int as I
import qualified Prelude
......@@ -67,9 +67,9 @@ buildTree bb particles
subTrees = [:buildTree bb' ps | (bb', ps) <- zipP boxes splitPnts:]
(Box llx lly rux ruy) = bb
sx = rux - llx
sy = ruy - lly
s = if sx < sy then sx else sy
sx = rux D.- llx
sy = ruy D.- lly
s = if sx D.< sy then sx else sy
-- | Split massPoints according to their locations in the quadrants.
......@@ -93,13 +93,13 @@ splitPoints b@(Box llx lly rux ruy) particles
b4 = Box midx lly rux midy
boxes = singletonP b1 +:+ singletonP b2 +:+ singletonP b3 +:+ singletonP b4
splitPars = singletonP lls +:+ singletonP lus +:+ singletonP rus +:+ singletonP rls
(midx, midy) = ((llx + rux) / 2.0 , (lly + ruy) / 2.0)
(midx, midy) = ((llx D.+ rux) D./ 2.0 , (lly D.+ ruy) D./ 2.0)
-- | Checks if particle is in box (excluding left and lower border)
inBox :: BoundingBox -> MassPoint -> Bool
inBox (Box llx lly rux ruy) (MP px py _)
= (px > llx) && (px <= rux) && (py > lly) && (py <= ruy)
= (px D.> llx) && (px D.<= rux) && (py D.> lly) && (py D.<= ruy)
-- | Calculate the centroid of some points.
......@@ -107,7 +107,7 @@ calcCentroid:: [:MassPoint:] -> MassPoint
calcCentroid mpts
= MP (sumP xs / mass) (sumP ys / mass) mass
where mass = sumP [: m | MP _ _ m <- mpts :]
(xs, ys) = unzipP [: (m * x, m * y) | MP x y m <- mpts :]
(xs, ys) = unzipP [: (m D.* x, m D.* y) | MP x y m <- mpts :]
-- | Calculate the accelleration of a point due to the points in the given tree.
......@@ -132,12 +132,12 @@ accel :: Double -- ^ If the distance between the points is smaller than
-> Accel
accel epsilon (MP x1 y1 _) (MP x2 y2 m)
= (aabs * dx / r , aabs * dy / r)
where rsqr = (dx * dx) + (dy * dy) + epsilon * epsilon
= (aabs D.* dx D./ r , aabs D.* dy D./ r)
where rsqr = (dx D.* dx) D.+ (dy D.* dy) D.+ epsilon D.* epsilon
r = sqrt rsqr
dx = x1 - x2
dy = y1 - y2
aabs = m / rsqr
dx = x1 D.- x2
dy = y1 D.- y2
aabs = m D./ rsqr
-- | If the point is far from a cell in the tree then we can use
......@@ -149,8 +149,8 @@ isFar :: MassPoint -- point being accelerated
-> Bool
isFar (MP x1 y1 m) s x2 y2
= let dx = x2 - x1
dy = y2 - y1
dist = sqrt (dx * dx + dy * dy)
in (s / dist) < 1
= let dx = x2 D.- x1
dy = y2 D.- y1
dist = sqrt (dx D.* dx D.+ dy D.* dy)
in (s D./ dist) D.< 1
......@@ -6,14 +6,14 @@ module QuickHullVect (quickhull) where
import Types
import Data.Array.Parallel
import Data.Array.Parallel.Prelude.Double
import Data.Array.Parallel.Prelude.Double as D
import qualified Data.Array.Parallel.Prelude.Int as Int
import qualified Prelude as P
distance :: Point -> Line -> Double
distance (xo, yo) ((x1, y1), (x2, y2))
= (x1-xo) * (y2 - yo) - (y1 - yo) * (x2 - xo)
= (x1 D.- xo) D.* (y2 D.- yo) D.- (y1 D.- yo) D.* (x2 D.- xo)
hsplit :: [:Point:] -> Line -> [:Point:]
hsplit points line@(p1, p2)
......@@ -22,7 +22,7 @@ hsplit points line@(p1, p2)
= concatP [: hsplit packed ends | ends <- [:(p1, pm), (pm, p2):] :]
where
cross = [: distance p line | p <- points :]
packed = [: p | (p,c) <- zipP points cross, c > 0.0 :]
packed = [: p | (p,c) <- zipP points cross, c D.> 0.0 :]
pm = points !: maxIndexP cross
quickHull' :: [:Point:] -> [:Point:]
......
......@@ -3,12 +3,12 @@
module SumNatsVect (sumNats) where
import Data.Array.Parallel.Prelude
import Data.Array.Parallel.Prelude.Int
import Data.Array.Parallel.Prelude.Int as I
import qualified Prelude as P
sumNats :: Int -> Int
sumNats maxN
= sumP [: x | x <- enumFromToP 0 (maxN - 1)
, (x `mod` 3 == 0) || (x `mod` 5 == 0) :]
= sumP [: x | x <- enumFromToP 0 (maxN I.- 1)
, (x `mod` 3 I.== 0) || (x `mod` 5 I.== 0) :]
......@@ -14,12 +14,12 @@
{-# OPTIONS -fvectorise #-}
module WordsVect
( wordsOfPArray
, wordCountOfPArray )
( wordsOfPArray
, wordCountOfPArray )
where
import qualified Data.Array.Parallel.Prelude.Word8 as W
import Data.Array.Parallel.Prelude.Word8 (Word8)
import Data.Array.Parallel.Prelude.Int
import qualified Data.Array.Parallel.Prelude.Word8 as W
import Data.Array.Parallel.Prelude.Word8 (Word8)
import Data.Array.Parallel.Prelude.Int as I
import Data.Array.Parallel
import qualified Prelude as Prel
......@@ -34,24 +34,24 @@ type String = [: Char :]
-- | Word state
data State
= Chunk String
| Seg String -- initial word chunk
[:String:] -- complete words in the middle of the segment
String -- final word chunk
= Chunk String
| Seg String -- initial word chunk
[:String:] -- complete words in the middle of the segment
String -- final word chunk
-- | Compose two wordstates.
plusState :: State -> State -> State
plusState str1 str2
= case (str1, str2) of
(Chunk as, Chunk bs) -> Chunk (as +:+ bs)
(Chunk as, Seg bl bss br) -> Seg (as +:+ bl) bss br
(Seg al ass ar, Chunk bs) -> Seg al ass (ar +:+ bs)
(Seg al ass ar, Seg bl bss br) -> Seg al (ass +:+ joinEmpty [:ar +:+ bl:] +:+ bss) br
(Chunk as, Chunk bs) -> Chunk (as +:+ bs)
(Chunk as, Seg bl bss br) -> Seg (as +:+ bl) bss br
(Seg al ass ar, Chunk bs) -> Seg al ass (ar +:+ bs)
(Seg al ass ar, Seg bl bss br) -> Seg al (ass +:+ joinEmpty [:ar +:+ bl:] +:+ bss) br
joinEmpty :: [:[:Word8:]:] -> [:[:Word8:]:]
joinEmpty ws
| lengthP ws == 1 && lengthP (ws !: 0) == 0 = [::]
| lengthP ws I.== 1 && lengthP (ws !: 0) I.== 0 = [::]
| otherwise = ws
......@@ -67,12 +67,12 @@ stateOfString :: String -> State
stateOfString str
= let len = lengthP str
result
| len == 0 = Chunk [::]
| len == 1 = stateOfChar (str !: 0)
| len I.== 0 = Chunk [::]
| len I.== 1 = stateOfChar (str !: 0)
| otherwise
= let half = len `div` 2
s1 = sliceP 0 half str
s2 = sliceP half (len-half) str
s2 = sliceP half (len I.- half) str
in plusState (stateOfString s1) (stateOfString s2)
in result
......@@ -82,11 +82,11 @@ countWordsOfState :: State -> Int
countWordsOfState state
= case state of
Chunk c -> wordsInChunkArr c
Seg c1 ws c2 -> wordsInChunkArr c1 + lengthP ws + wordsInChunkArr c2
Seg c1 ws c2 -> wordsInChunkArr c1 I.+ lengthP ws I.+ wordsInChunkArr c2
wordsInChunkArr :: [:Word8:] -> Int
wordsInChunkArr arr
| lengthP arr == 0 = 0
| lengthP arr I.== 0 = 0
| otherwise = 1
......
......@@ -16,6 +16,7 @@ data (,) a b = (,) a b -- Defined in `GHC.Tuple'
instance (Bounded a, Bounded b) => Bounded (a, b)
-- Defined in `GHC.Enum'
instance (Eq a, Eq b) => Eq (a, b) -- Defined in `GHC.Classes'
instance Functor ((,) a) -- Defined in `GHC.Base'
instance (Ord a, Ord b) => Ord (a, b) -- Defined in `GHC.Classes'
instance (Read a, Read b) => Read (a, b) -- Defined in `GHC.Read'
instance (Show a, Show b) => Show (a, b) -- Defined in `GHC.Show'
data (->) a b -- Defined in `GHC.Prim'
instance Monad ((->) r) -- Defined in `GHC.Base'
instance Functor ((->) r) -- Defined in `GHC.Base'
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
test('instance-leaks', normal, compile, ['-hide-all-packages -package haskell98'])
-- Check that the instances in Control.Monad.Instances do not leak
-- into any Haskell 98 modules.
module Main where
-- import all Haskell 98 modules
import Array
import Char
import Complex
import CPUTime
import Directory
import IO
import Ix
import List
import Locale
import Maybe
import Monad
import Numeric
import Random
import Ratio
import System
import Time
-- This will fail if any of the Haskell 98 modules indirectly import
-- Control.Monad.Instances
instance Functor ((->) r) where fmap = (.)
main = undefined
......@@ -30,5 +30,9 @@ integerConstantFolding:
$(call CHECK,\<6253\>,shiftRInteger)
$(call CHECK,\<641\>,quotInteger)
$(call CHECK,\<68\>,remInteger)
$(call CHECK,\<200131.0\>,doubleFromInteger)
$(call CHECK,\<200135.0\>,floatFromInteger)
$(call CHECK,\<400276.0\>,encodeIntegerDouble)
$(call CHECK,\<400280.0\>,encodeIntegerFloat)
./integerConstantFolding
......@@ -46,6 +46,10 @@ main = do p "plusInteger" plusInteger
p "shiftRInteger" shiftRInteger
p "quotInteger" quotInteger
p "remInteger" remInteger
p "doubleFromInteger" doubleFromInteger
p "floatFromInteger" floatFromInteger
p "encodeIntegerDouble" encodeIntegerDouble
p "encodeIntegerFloat" encodeIntegerFloat
where p :: Show a => String -> a -> IO ()
p str x = putStrLn (str ++ ": " ++ show x)
......@@ -159,3 +163,19 @@ quotInteger = 100063 `quot` 156
remInteger :: Integer
remInteger = 100064 `rem` 156
-- For the conversion functions, we can't just check that e.g. 100065
-- is in the resulting core, because it will be regardless of whether
-- the rules fire or not. So we add 100066, and thus rely on the
-- Double addition rule also firing.
doubleFromInteger :: Double
doubleFromInteger = fromInteger 100065 + 100066
floatFromInteger :: Float
floatFromInteger = fromInteger 100067 + 100068
encodeIntegerDouble :: Double
encodeIntegerDouble = encodeFloat 100069 2
encodeIntegerFloat :: Float
encodeIntegerFloat = encodeFloat 100070 2
......@@ -40,3 +40,7 @@ shiftLInteger: 1600976
shiftRInteger: 6253
quotInteger: 641
remInteger: 68
doubleFromInteger: 200131.0
floatFromInteger: 200135.0
encodeIntegerDouble: 400276.0
encodeIntegerFloat: 400280.0
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment