Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
db6d9cd7
Commit
db6d9cd7
authored
Jan 16, 2012
by
chak@cse.unsw.edu.au.
Browse files
Adapt DPH tests to classes in the DPH library
parent
5601845d
Changes
6
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/dph/diophantine/DiophantineVect.hs
View file @
db6d9cd7
...
...
@@ -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
...
...
testsuite/tests/dph/dotp/DotPVect.hs
View file @
db6d9cd7
...
...
@@ -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
)
testsuite/tests/dph/nbody/Solver.hs
View file @
db6d9cd7
...
...
@@ -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
testsuite/tests/dph/quickhull/QuickHullVect.hs
View file @
db6d9cd7
...
...
@@ -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
:
]
...
...
testsuite/tests/dph/sumnats/SumNatsVect.hs
View file @
db6d9cd7
...
...
@@ -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
)
:
]
testsuite/tests/dph/words/WordsVect.hs
View file @
db6d9cd7
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment