Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Sign in / Register
Toggle navigation
N
nofib
Project
Project
Details
Activity
Releases
Cycle Analytics
Insights
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Locked Files
Issues
4
Issues
4
List
Boards
Labels
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Security & Compliance
Security & Compliance
Dependency List
Packages
Packages
List
Container Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
nofib
Commits
2640ba70
Commit
2640ba70
authored
Jul 20, 2010
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
update to work with parallel3.x
parent
01fefbbb
Changes
7
Hide whitespace changes
Inline
Sidebyside
Showing
7 changed files
with
52 additions
and
221 deletions
+52
221
Makefile
parallel/Makefile
+5
1
coins.hs
parallel/coins/coins.hs
+3
1
Illumination.hs
parallel/gray/Illumination.hs
+9
24
Mandel.lhs
parallel/mandel/Mandel.lhs
+12
113
Tree.hs
parallel/partree/Tree.hs
+3
3
Rsa.hs
parallel/prsa/Rsa.hs
+9
12
Main.lhs
parallel/ray/Main.lhs
+11
67
No files found.
parallel/Makefile
View file @
2640ba70
TOP
=
..
include
$(TOP)/mk/boilerplate.mk
SUBDIRS
=
parfib partree sumeuler matmult ray gray prsa mandel queens
SUBDIRS
=
parfib partree sumeuler matmult ray gray prsa mandel queens coins
# CPP SYMBOLS
#
# DSTRATEGIES_2 to use the version 2 strategies library (default is 3)
# partak: program needs work to make it parallel
...
...
parallel/coins/coins.hs
View file @
2640ba70
...
...
@@ 3,6 +3,8 @@
import
Data.List
import
System.Environment
import
Control.Parallel
import
Control.Parallel.Strategies
import
Control.Applicative
 Rough results, GHC 6.13: (val=777)
 V1 (SDM): 2.2s
...
...
@@ 76,7 +78,7 @@ payA_par depth val ((c,q):coins) acc

otherwise
=
res
where
res
=
right
`
par
`
left
`
pseq
`
append
left
right
res
=
unEval
$
pure
append
<*>
rpar
left
<*>
rwhnf
right
left
=
payA_par
(
if
q
==
1
then
(
depth

1
)
else
depth
)
(
val

c
)
coins'
(
c
:
acc
)
right
=
payA_par
(
depth

1
)
val
coins
acc
...
...
parallel/gray/Illumination.hs
View file @
2640ba70
...
...
@@ 5,7 +5,7 @@
 Modified to use stdout (for testing)
{# LANGUAGE BangPatterns #}
{# LANGUAGE BangPatterns
,CPP
#}
module
Illumination
(
Object
,
Light
(
..
)
...
...
@@ 14,6 +14,7 @@ module Illumination
)
where
import
Control.Parallel
import
Control.Parallel.Strategies
(
withStrategy
,
parBuffer
,
rwhnf
)
import
Array
import
Char
(
chr
)
...
...
@@ 33,9 +34,15 @@ render :: (Matrix,Matrix) > Color > [Light] > Object > Int >
Radian
>
Int
>
Int
>
String
>
IO
()
render
(
m
,
m'
)
amb
ls
obj
dep
fov
wid
ht
file
=
do
{
debugging
;
putStrLn
(
showBitmap'
wid
ht
(
lazyParList
100
(
map
(
\
x
>
seqList
x
`
pseq
`
x
)
pixels
)
))
;
putStrLn
(
showBitmap'
wid
ht
(
parallel
pixels
))
}
where
#
ifdef
STRATEGIES_2
parallel
=
parBuffer
100
rwhnf
.
map
(
\
x
>
seqList
x
`
pseq
`
x
)
#
else
parallel
=
withStrategy
(
parBuffer
100
rwhnf
)
.
map
(
\
x
>
seqList
x
`
pseq
`
x
)
#
endif
debugging
=
return
()
{
do { putStrLn (show cxt)
...
...
@@ 70,32 +77,10 @@ render (m,m') amb ls obj dep fov wid ht file

(
xd
,
yd
)
<
[(

0.333
,
0.0
),
(
0.333
,
0.0
),
(
0.0
,

0.333
),
(
0.0
,
0.333
)]
]
parListN
::
Int
>
[
a
]
>
[
a
]
parListN
0
xs
=
xs
parListN
!
n
[]
=
[]
parListN
!
n
(
x
:
xs
)
=
x
`
par
`
parListN
(
n

1
)
xs
 like parListN, but starts the sparks in reverse order
parListN1
::
Int
>
[
a
]
>
[
a
]
>
[
a
]
parListN1
0
xs
ys
=
parList
ys
`
pseq
`
xs
parListN1
!
n
[]
ys
=
parList
ys
`
pseq
`
[]
parListN1
!
n
(
x
:
xs
)
ys
=
parListN1
(
n

1
)
xs
(
x
:
ys
)
seqList
::
[
a
]
>
()
seqList
[]
=
()
seqList
(
x
:
xs
)
=
x
`
pseq
`
seqList
xs
parList
::
[
a
]
>
()
parList
[]
=
()
parList
(
x
:
xs
)
=
x
`
par
`
parList
xs
lazyParList
::
Int
>
[
a
]
>
[
a
]
lazyParList
!
n
xs
=
go
xs
(
parListN1
n
xs
[]
)
where
go
[]
_ys
=
[]
go
(
x
:
xs
)
[]
=
x
:
xs
go
(
x
:
xs
)
(
y
:
ys
)
=
y
`
par
`
(
x
:
go
xs
ys
)
avg
cs
=
divN
(
fromIntegral
(
length
cs
))
(
uncolor
(
sumCC
cs
))
where
divN
n
(
r
,
g
,
b
)
=
color
(
r
/
n
)
(
g
/
n
)
(
b
/
n
)
...
...
parallel/mandel/Mandel.lhs
View file @
2640ba70
...
...
@@ 7,12 +7,12 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{onlystandalone}
\begin{code}
{# LANGUAGE BangPatterns #}
{# LANGUAGE BangPatterns
,CPP
#}
module Mandel where
import Complex  1.3
import PortablePixmap
import Control.Parallel
import Control.Parallel.Strategies
(using)
import Control.Parallel.Strategies
 import qualified NewStrategies as NS
default ()
\end{code}
...
...
@@ 125,121 +125,20 @@ the @whenDiverge@ function over a complex plain of values.
\begin{code}
parallelMandel:: [[Complex Double]] > Int > Double > [Int]
parallelMandel mat limit radius
= concat $
 NewStrategies version:
 NS.parListBuffer 50 (NS.seqList id) $
 map (map (whenDiverge limit radius)) mat
 NewStrategies version:
 NS.parListBufferRev 50 (NS.seqList id) $
 map (map (whenDiverge limit radius)) mat
 lazyParList version:
 lazyParList 50
 [ let l = map (whenDiverge limit radius) xs
 in seqList l `pseq` l
  xs < mat ]
 lazyParList1 version:
parBuffer 70
[ let l = map (whenDiverge limit radius) xs
in seqList l `pseq` l
 xs < mat ]
 = lazyParListChunk 100 100 $ map (whenDiverge limit radius) mat
 = lazyParMap 512 (whenDiverge limit radius) mat
parBuffer :: Int > [a] > [a]
parBuffer n xs = return xs (start n xs)
= concat $ parallel [ let l = map (whenDiverge limit radius) xs
in Mandel.seqList l `pseq` l
 xs < mat ]
where
return (x:xs) (y:ys) = y `par` (x : return xs ys)
return xs [] = xs
start !n [] = []
start 0 ys = ys
start !n (y:ys) = y `par` start (n1) ys
 parListN :: Int > [a] > [a]
 parListN 0 xs = xs
 parListN !n [] = []
 parListN !n (x:xs) = x `par` parListN (n1) xs
lazyParList :: Int > [a] > [a]
lazyParList !n xs = go xs (parListN n xs)
where
go [] _ys = []
go (x:xs) [] = x : xs
go (x:xs) (y:ys) = y `par` (x : go xs ys)
lazyParList1 :: Int > [a] > [a]
lazyParList1 !n xs = go xs (parListN1 n xs [])
where
go [] _ys = []
go (x:xs) [] = x : xs
go (x:xs) (y:ys) = y `par` (x : go xs ys)
 parMap :: (a > b) > [a] > [b]
 parMap f [] = []
 parMap f (x:xs) = let fx = f x; fxs = parMap f xs in fx `par` fxs `pseq` fx:fxs
parList :: [a] > ()
parList [] = ()
parList (x:xs) = x `par` parList xs
 parListN version 1: leads to fights as all capabilities try to
 steal the early sparks, and the main thread gets blocked.
parListN :: Int > [a] > [a]
parListN 0 xs = xs
parListN !n [] = []
parListN !n (x:xs) = x `par` parListN (n1) xs
 like parListN, but starts the sparks in reverse order
parListN1 :: Int > [a] > [a] > [a]
parListN1 0 xs ys = parList ys `pseq` xs
parListN1 !n [] ys = parList ys `pseq` []
parListN1 !n (x:xs) ys = parListN1 (n1) xs (x:ys)
#ifdef STRATEGIES_2
parallel = parBuffer 70 rwhnf
#else
parallel = withStrategy (parBuffer 70 rwhnf)
#endif
seqList :: [a] > ()
seqList [] = ()
seqList (x:xs) = x `pseq` seqList xs

 parListChunk :: Int > [a] > ()
 parListChunk n [] = ()
 parListChunk n xs = let (ys,zs) = splitAt n xs in
 seqList ys `par` parListChunk n zs
 parListChunkWHNF :: Int > [a] > [a]
 parListChunkWHNF n
 = concat
 . (`using` parList)
 . map (`using` seqList)
 . chunk n
 chunk n [] = []
 chunk n xs = as : chunk n bs where (as,bs) = splitAt n xs

 lazyParList :: Int > [a] > [a]
 lazyParList !n xs = go xs (parListN' n xs [])
 where
 go [] _ys = []
 go (x:xs) [] = x : xs
 go (x:xs) (y:ys) = y `par` (x : go xs ys)
 lazyParListChunk :: Int > Int > [a] > [a]
 lazyParListChunk !n !size xs = go chunks seqchunks (parListN n seqchunks)
 where
 chunks = chunkList size xs
 seqchunks = map seqList chunks

 go :: [[a]] > [()] > [()] > [a]
 go [] _ _ys = []
 go (x:xs) _ [] = concat (x:xs)
 go (x:xs) (y:ys) (z:zs) = z `par` y `pseq` (x ++ go xs ys zs)

 chunkList :: Int > [a] > [[a]]
 chunkList !n [] = []
 chunkList !n xs = chunk : chunkList n rest
 where (chunk,rest) = splitAt n xs
seqList (x:xs) = x `pseq` Mandel.seqList xs
\end{code}
\section{Initialisation of data and graphical rendering.}
...
...
parallel/partree/Tree.hs
View file @
2640ba70
 * haskell *
 Timestamp: <20100
525 16:25:18
simonmar>
 Timestamp: <20100
716 12:10:03
simonmar>

 ADT of a binary tree (values only in leaves).
 Parallel functions use par and seq directly.
...
...
@@ 30,11 +30,11 @@ par_tree_map f (Node left right) =
Node
(
par_tree_map
f
left
)
(
par_tree_map
f
right
)
`
using
`
partree
where
partree
(
Node
l
r
)
=
do
l'
<
(
rpar
`
dot
`
rtree
)
l
l'
<
rpar
(
l
`
using
`
rtree
)
r'
<
rtree
r
return
(
Node
l'
r'
)
rtree
t
=
force_tree
t
`
pseq
`
Done
t
rtree
t
=
force_tree
t
`
pseq
`
return
t
 force evaluation of tree (could use Strategies module instead!)
force_tree
::
(
Integral
a
)
=>
Tree
a
>
()
...
...
parallel/prsa/Rsa.hs
View file @
2640ba70
{# LANGUAGE BangPatterns #}
{# LANGUAGE BangPatterns
,CPP
#}
module
Rsa
(
encrypt
,
decrypt
,
makeKeys
)
where
import
Control.Parallel
import
Control.Parallel.Strategies
encrypt
,
decrypt
::
Integer
>
Integer
>
String
>
String
encrypt
n
e
=
unlines
.
par
Buffer
100
.
map
(
show
.
power
e
n
.
code
)
.
collect
(
size
n
)
decrypt
n
d
=
concat
.
par
Buffer
100
.
map
(
decode
.
power
d
n
.
read
)
.
lines
encrypt
n
e
=
unlines
.
par
allel
.
map
(
show
.
power
e
n
.
code
)
.
collect
(
size
n
)
decrypt
n
d
=
concat
.
par
allel
.
map
(
decode
.
power
d
n
.
read
)
.
lines
 Parallelism 
#
ifdef
STRATEGIES_2
parallel
=
parBuffer
100
rwhnf
#
else
parallel
=
withStrategy
(
parBuffer
100
rseq
)
#
endif
parBuffer
::
Int
>
[
a
]
>
[
a
]
parBuffer
n
xs
=
return
xs
(
start
n
xs
)
where
return
(
x
:
xs
)
(
y
:
ys
)
=
y
`
par
`
(
x
:
return
xs
ys
)
return
xs
[]
=
xs
start
!
n
[]
=
[]
start
0
ys
=
ys
start
!
n
(
y
:
ys
)
=
y
`
par
`
start
(
n

1
)
ys
parmap
::
(
String
>
String
)
>
[
String
]
>
[
String
]
parmap
f
[]
=
[]
...
...
parallel/ray/Main.lhs
View file @
2640ba70
The Ray tracer algorithm taken from Paul Kelly's book, adapted by Greg
Michaelson for SML, converted to (parallel) Haskell by Kevin Hammond!
>
{# LANGUAGE BangPatterns #}
>
{# LANGUAGE BangPatterns
,CPP
#}
>
import
Control.Parallel
>
import
Control.Parallel.Strategies
(
Strategy
,
sparking
,
rwhnf
,
parBuffer
)
>
import
Control.Parallel.Strategies
(
Strategy
,
withStrategy
,
rwhnf
,
parBuffer
)
>
import
System.Environment
>
main
=
do
...
...
@@ 138,71 +138,15 @@ in_poly_test (p,q,r) (A,B,C) Vs
>
where
earliest
=
insert
earlier
NoImpact
>
findImpacts
::
[
Ray
]
>
[
Object
]
>
[
Impact
]
>
findImpacts
rays
objects
=
parBuffer
200
rwhnf
$
map
(
firstImpact
objects
)
rays
>
using
::
a
>
(
a
>
()
)
>
a
>
using
a
s
=
s
a
`
seq
`
a
>
chunk
n
[]
=
[]
>
chunk
n
xs
=
as
:
chunk
n
bs
where
(
as
,
bs
)
=
splitAt
n
xs
mymap f xs = go xs where go [] = []; go (x:xs) = f x : go xs
>
mymap
f
[]
=
[]
>
mymap
f
(
x
:
xs
)
=
f
x
:
map
f
xs
>
parmap
::
(
a
>
b
)
>
[
a
]
>
[
b
]
>
parmap
f
[]
=
[]
>
parmap
f
(
x
:
xs
)
=
fx
`
par
`
(
pmxs
`
par
`
(
fx
:
pmxs
))
>
where
fx
=
f
x
>
pmxs
=
parmap
f
xs
myParBuffer :: Int > [a] > [a]
myParBuffer n xs = return xs (start n xs)
where
return (x:xs) (y:ys) = y `par` (x : return xs ys)
return xs [] = xs
start !n [] = []
start 0 ys = ys
start !n (y:ys) = y `par` start (n1) ys
parBuffer' :: Int > Strategy a > [a] > [a]
parBuffer' n s xs = return xs (start n xs)
where
return (x:xs) (y:ys) = (x : return xs ys)
`sparking` s y
return xs [] = xs
start !n [] = []
start 0 ys = ys
start !n (y:ys) = start (n1) ys `sparking` s y
>
parListN
::
Int
>
[
a
]
>
[
a
]
>
parListN
0
xs
=
xs
>
parListN
!
n
[]
=
[]
>
parListN
!
n
(
x
:
xs
)
=
x
`
par
`
parListN
(
n

1
)
xs
>
>
 like parListN, but starts the sparks in reverse order
>
parListN1
::
Int
>
[
a
]
>
[
a
]
>
[
a
]
>
parListN1
0
xs
ys
=
parList
ys
`
pseq
`
xs
>
parListN1
!
n
[]
ys
=
parList
ys
`
pseq
`
[]
>
parListN1
!
n
(
x
:
xs
)
ys
=
parListN1
(
n

1
)
xs
(
x
:
ys
)
>
>
seqList
::
[
a
]
>
()
>
seqList
[]
=
()
>
seqList
(
x
:
xs
)
=
x
`
pseq
`
seqList
xs
>
>
parList
::
[
a
]
>
()
>
parList
[]
=
()
>
parList
(
x
:
xs
)
=
x
`
par
`
parList
xs
>
>
lazyParList
::
Int
>
[
a
]
>
[
a
]
>
lazyParList
!
n
xs
=
go
xs
(
parListN
n
xs
)
>
where
>
go
[]
_ys
=
[]
>
go
(
x
:
xs
)
[]
=
x
:
xs
>
go
(
x
:
xs
)
(
y
:
ys
)
=
y
`
par
`
(
x
:
go
xs
ys
)
>
findImpacts
rays
objects
=
parallel
$
>
map
(
firstImpact
objects
)
rays
>
where
#ifdef STRATEGIES_2
>
parallel
=
parBuffer
200
rwhnf
#else
>
parallel
=
withStrategy
(
parBuffer
200
rwhnf
)
#endif
(*** Functions to generate a list of rays ******
GenerateRays Detail X Y Z
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a 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