Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Tobias Decking
GHC
Commits
a2775fd8
Commit
a2775fd8
authored
Oct 16, 2006
by
Simon Marlow
Browse files
remove use of FiniteMap, use Text.Printf
parent
80b1239e
Changes
3
Hide whitespace changes
Inline
Side-by-side
utils/nofib-analyse/Main.hs
View file @
a2775fd8
...
...
@@ -7,13 +7,14 @@
module
Main
where
import
GenUtils
import
Text.Printf
import
Slurp
import
CmdLine
import
Text.Printf
import
Text.Html
hiding
((
!
))
import
qualified
Text.Html
as
Html
((
!
))
import
Data.FiniteMap
import
qualified
Data.Map
as
Map
import
Data.Map
(
Map
)
import
System.Console.GetOpt
import
System.Exit
(
exitWith
,
ExitCode
(
..
)
)
...
...
@@ -66,7 +67,7 @@ main = do
-- sanity check
sequence_
[
checkTimes
prog
res
|
table
<-
results
,
(
prog
,
res
)
<-
fmT
oList
table
]
(
prog
,
res
)
<-
Map
.
t
oList
table
]
case
()
of
_
|
html
->
...
...
@@ -104,7 +105,7 @@ data PerModuleTableSpec =
SpecM
String
-- Name of the table
String
-- HTML tag for the table
(
Results
->
Finite
Map
String
a
)
-- get the module map
(
Results
->
Map
String
a
)
-- get the module map
(
a
->
Bool
)
-- Result within reasonable limits?
-- The various per-program aspects of execution that we can generate results for.
...
...
@@ -182,7 +183,7 @@ cachegrind_summary_specs =
-- in instructions, mem reads and mem writes (and vice-versa).
pickSummary
::
[
ResultTable
]
->
[
PerProgTableSpec
]
pickSummary
rs
|
isNothing
(
instrs
(
head
(
eltsFM
(
head
rs
))))
=
normal_summary_specs
|
isNothing
(
instrs
(
head
(
Map
.
elems
(
head
rs
))))
=
normal_summary_specs
|
otherwise
=
cachegrind_summary_specs
per_module_result_tab
=
...
...
@@ -251,7 +252,7 @@ htmlShowResults (r:rs) ss f stat result_ok
++
[
tableRow
(
-
1
)
(
"Average"
,
gms
)])
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
results_per_prog
=
map
(
calc_result
rs
f
stat
result_ok
)
(
fmT
oList
r
)
results_per_prog
=
map
(
calc_result
rs
f
stat
result_ok
)
(
Map
.
t
oList
r
)
results_per_run
=
transpose
(
map
snd
results_per_prog
)
(
lows
,
gms
,
highs
)
=
unzip3
(
map
calc_gmsd
results_per_run
)
...
...
@@ -260,7 +261,7 @@ htmlShowMultiResults
::
Result
a
=>
[
ResultTable
]
->
[
String
]
->
(
Results
->
Finite
Map
String
a
)
->
(
Results
->
Map
String
a
)
->
(
a
->
Bool
)
->
HtmlTable
...
...
@@ -276,18 +277,18 @@ htmlShowMultiResults (r:rs) ss f result_ok =
<->
tableRow
(
-
1
)
(
""
,
gms
)])
where
base_results
=
fmT
oList
r
::
[(
String
,
Results
)]
base_results
=
Map
.
t
oList
r
::
[(
String
,
Results
)]
-- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
results_per_prog_mod_run
=
map
get_results_for_prog
base_results
-- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
get_results_for_prog
(
prog
,
r
)
=
(
prog
,
map
get_results_for_mod
(
fmT
oList
(
f
r
)))
get_results_for_prog
(
prog
,
r
)
=
(
prog
,
map
get_results_for_mod
(
Map
.
t
oList
(
f
r
)))
where
fms
=
map
get_run_results
rs
get_run_results
fm
=
case
lookup
FM
fm
prog
of
Nothing
->
empty
FM
get_run_results
fm
=
case
Map
.
lookup
prog
fm
of
Nothing
->
Map
.
empty
Just
res
->
f
res
get_results_for_mod
(
id
,
attr
)
=
calc_result
fms
Just
(
const
Success
)
...
...
@@ -423,7 +424,7 @@ ascii_show_results (r:rs) ss f stat result_ok
.
show_per_prog_results
(
"Average"
,
gms
)
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
results_per_prog
=
map
(
calc_result
rs
f
stat
result_ok
)
(
fmT
oList
r
)
results_per_prog
=
map
(
calc_result
rs
f
stat
result_ok
)
(
Map
.
t
oList
r
)
results_per_run
=
transpose
(
map
snd
results_per_prog
)
(
lows
,
gms
,
highs
)
=
unzip3
(
map
calc_gmsd
results_per_run
)
...
...
@@ -446,8 +447,8 @@ ascii_summary_table latex (r1:r2:_) specs mb_restrict
(
headings
,
columns
,
av_cols
)
=
unzip3
(
map
calc_col
specs
)
av_heads
=
[
BoxString
"Min"
,
BoxString
"Max"
,
BoxString
"Geometric Mean"
]
baseline
=
fmT
oList
r1
progs
=
map
BoxString
(
keys
FM
r1
)
baseline
=
Map
.
t
oList
r1
progs
=
map
BoxString
(
Map
.
keys
r1
)
rows0
=
map
TableRow
(
zipWith
(
:
)
progs
(
transpose
columns
))
rows1
=
restrictRows
mb_restrict
rows0
...
...
@@ -494,7 +495,7 @@ ascii_show_multi_results
::
Result
a
=>
[
ResultTable
]
->
[
String
]
->
(
Results
->
Finite
Map
String
a
)
->
(
Results
->
Map
String
a
)
->
(
a
->
Bool
)
->
ShowS
...
...
@@ -510,18 +511,18 @@ ascii_show_multi_results (r:rs) ss f result_ok
.
str
"
\n
"
.
show_per_prog_results
(
"Average"
,
gms
)
where
base_results
=
fmT
oList
r
::
[(
String
,
Results
)]
base_results
=
Map
.
t
oList
r
::
[(
String
,
Results
)]
-- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
results_per_prog_mod_run
=
map
get_results_for_prog
base_results
-- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
get_results_for_prog
(
prog
,
r
)
=
(
prog
,
map
get_results_for_mod
(
fmT
oList
(
f
r
)))
get_results_for_prog
(
prog
,
r
)
=
(
prog
,
map
get_results_for_mod
(
Map
.
t
oList
(
f
r
)))
where
fms
=
map
get_run_results
rs
get_run_results
fm
=
case
lookup
FM
fm
prog
of
Nothing
->
empty
FM
get_run_results
fm
=
case
Map
.
lookup
prog
fm
of
Nothing
->
Map
.
empty
Just
res
->
f
res
get_results_for_mod
(
id
,
attr
)
=
calc_result
fms
Just
(
const
Success
)
...
...
@@ -553,7 +554,7 @@ show_per_prog_results_width width (prog,results)
-- calc_result is a nice exercise in higher-order programming...
calc_result
::
Result
a
=>
[
Finite
Map
String
b
]
-- accumulated results
=>
[
Map
String
b
]
-- accumulated results
->
(
b
->
Maybe
a
)
-- get a result from the b
->
(
b
->
Status
)
-- get a status from the b
->
(
a
->
Bool
)
-- is this result ok?
...
...
@@ -564,7 +565,7 @@ calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
(
prog
,
(
just_result
baseline
base_stat
:
let
rts'
=
map
(
\
rt
->
get_stuff
(
lookup
FM
rt
prog
))
rts
rts'
=
map
(
\
rt
->
get_stuff
(
Map
.
lookup
prog
rt
))
rts
get_stuff
Nothing
=
(
Nothing
,
NotDone
)
get_stuff
(
Just
r
)
=
(
get_maybe_a
r
,
get_stat
r
)
...
...
@@ -689,17 +690,18 @@ data BoxValue
showBox
::
BoxValue
->
String
showBox
(
RunFailed
stat
)
=
show_stat
stat
showBox
(
Percentage
f
)
=
show_pcntage
f
showBox
(
BoxFloat
f
)
=
showFFloat
(
Just
2
)
f
""
showBox
(
BoxFloat
f
)
=
printf
"%.2f"
f
showBox
(
BoxInt
n
)
=
show
(
n
`
div
`
1024
)
++
"k"
showBox
(
BoxInteger
n
)
=
show
(
n
`
div
`
1024
)
++
"k"
showBox
(
BoxString
s
)
=
s
instance
Show
BoxValue
where
{
show
=
showBox
}
show_pcntage
n
=
showFFloat
(
Just
1
)
(
n
-
100
)
"%"
--show_pcntage n = show_float_signed (n-100) ++ "%"
show_pcntage
n
=
show_float_signed
(
n
-
100
)
++
"%"
--show_float_signed = showFloat False False True False False Nothing (Just 1)
show_float_signed
n
|
n
>=
0
=
printf
"+%.1f"
n
|
otherwise
=
printf
"%.1f"
n
show_stat
Success
=
"(no result)"
show_stat
WrongStdout
=
"(stdout)"
...
...
utils/nofib-analyse/Printf.lhs
deleted
100644 → 0
View file @
80b1239e
-----------------------------------------------------------------------------
-- $Id: Printf.lhs,v 1.5 2002/03/14 17:09:46 simonmar Exp $
-- (c) Simon Marlow 1997-2001
-----------------------------------------------------------------------------
>
module
Printf
(
showFloat
,
showFloat'
)
where
>
import
Foreign
>
import
CTypes
>
import
CTypesISO
>
import
CString
>
import
IOExts
>
import
ByteArray
>
showFloat
> :: Bool -- Always print decimal point
> -
>
Bool
-- Left adjustment
> -
>
Bool
-- Always print sign
> -
>
Bool
-- Leave blank before positive number
> -
>
Bool
-- Use zero padding
> -
>
Maybe
Int
-- Field Width
> -
>
Maybe
Int
-- Precision
> -
>
Float
> -
>
String
>
bUFSIZE
=
512
::
Int
>
showFloat
alt
left
sign
blank
zero
width
prec
num
=
> unsafePerformIO $ do
#if __GLASGOW_HASKELL__ < 500
> buf <- malloc bUFSIZE
> snprintf buf (fromIntegral bUFSIZE) (packString format)
> (realToFrac num)
> let s = unpackCString buf
> length s `seq` -- urk! need to force the string before we
> -- free the buffer. A better solution would
> -- be to use foreign objects and finalisers,
> -- but that's just too heavyweight.
> free buf
> return s
#else
> allocaBytes bUFSIZE $ \buf ->
> withCString format $ \cformat -
>
do
> snprintf buf (fromIntegral bUFSIZE) cformat
> (realToFrac num)
> peekCString buf
#endif
>
where
> format = '%' :
> if_bool alt "#" ++
> if_bool left "-" ++
> if_bool sign "+" ++
> if_bool blank " " ++
> if_bool zero "0" ++
> if_maybe width show ++
> if_maybe prec (\s -
>
"."
++
show
s
)
++
> "f"
>
showFloat'
::
Maybe
Int
->
Maybe
Int
->
Float
->
String
>
showFloat'
=
showFloat
False
False
False
False
False
>
if_bool
False
s
=
[]
>
if_bool
True
s
=
s
>
if_maybe
Nothing
f
=
[]
>
if_maybe
(
Just
s
)
f
=
f
s
#if __GLASGOW_HASKELL__ < 500
>
type
PackedString
=
ByteArray
Int
>
foreign
import
unsafe
snprintf
::
Addr
->
CSize
->
PackedString
->
Double
->
IO
()
#else
>
foreign
import
unsafe
snprintf
::
CString
->
CSize
->
CString
->
Double
->
IO
()
#endif
utils/nofib-analyse/Slurp.hs
View file @
a2775fd8
...
...
@@ -7,7 +7,9 @@
module
Slurp
(
Status
(
..
),
Results
(
..
),
ResultTable
,
parse_log
)
where
import
CmdLine
import
Data.FiniteMap
import
qualified
Data.Map
as
Map
import
Data.Map
(
Map
)
import
Text.Regex
import
Data.Maybe
-- import Debug.Trace
...
...
@@ -15,7 +17,7 @@ import Data.Maybe
-----------------------------------------------------------------------------
-- This is the structure into which we collect our results:
type
ResultTable
=
Finite
Map
String
Results
type
ResultTable
=
Map
String
Results
data
Status
=
NotDone
...
...
@@ -27,8 +29,8 @@ data Status
|
WrongStderr
data
Results
=
Results
{
compile_time
::
Finite
Map
String
Float
,
module_size
::
Finite
Map
String
Int
,
compile_time
::
Map
String
Float
,
module_size
::
Map
String
Int
,
binary_size
::
Maybe
Int
,
link_time
::
Maybe
Float
,
run_time
::
[
Float
],
...
...
@@ -45,8 +47,8 @@ data Results = Results {
}
emptyResults
=
Results
{
compile_time
=
empty
FM
,
module_size
=
empty
FM
,
compile_time
=
Map
.
empty
,
module_size
=
Map
.
empty
,
binary_size
=
Nothing
,
link_time
=
Nothing
,
run_time
=
[]
,
...
...
@@ -127,10 +129,10 @@ parse_log
.
chunk_log
[]
[]
-- break at banner lines
.
lines
combine_results
::
[(
String
,
Results
)]
->
Finite
Map
String
Results
combine_results
=
foldr
f
empty
FM
combine_results
::
[(
String
,
Results
)]
->
Map
String
Results
combine_results
=
foldr
f
Map
.
empty
where
f
(
prog
,
results
)
fm
=
addToFM_C
combine2Results
fm
prog
results
f
(
prog
,
results
)
fm
=
Map
.
insertWith
(
flip
combine2Results
)
prog
results
fm
combine2Results
...
...
@@ -150,8 +152,8 @@ combine2Results
gc_time
=
gt2
,
gc_work
=
gw2
,
binary_size
=
bs2
,
allocs
=
al2
,
run_status
=
rs2
,
compile_status
=
cs2
}
=
Results
{
compile_time
=
plusFM_C
const
ct1
ct2
,
module_size
=
plusFM_C
const
ms1
ms2
,
=
Results
{
compile_time
=
Map
.
unionWith
(
flip
const
)
ct1
ct2
,
module_size
=
Map
.
unionWith
(
flip
const
)
ms1
ms2
,
link_time
=
combMaybes
lt1
lt2
,
run_time
=
rt1
++
rt2
,
mut_time
=
mt1
++
mt2
,
...
...
@@ -194,14 +196,14 @@ parse_compile_time prog mod [] = []
parse_compile_time
prog
mod
(
l
:
ls
)
=
case
matchRegex
time_re
l
of
{
Just
(
real
:
user
:
system
:
_
)
->
let
ct
=
addToFM
emptyFM
mod
(
read
user
)
let
ct
=
Map
.
singleton
mod
(
read
user
)
in
[(
prog
,
emptyResults
{
compile_time
=
ct
})];
Nothing
->
case
matchRegex
time_gnu17_re
l
of
{
Just
(
user
:
system
:
elapsed
:
_
)
->
let
ct
=
addToFM
emptyFM
mod
(
read
user
)
let
ct
=
Map
.
singleton
mod
(
read
user
)
in
[(
prog
,
emptyResults
{
compile_time
=
ct
})];
Nothing
->
...
...
@@ -212,7 +214,7 @@ parse_compile_time prog mod (l:ls) =
read_mut
=
read
mut
read_gc
=
read
gc
time
=
(
read
init
+
read_mut
+
read_gc
)
::
Float
ct
=
addToFM
emptyFM
mod
time
ct
=
Map
.
singleton
mod
time
in
[(
prog
,
emptyResults
{
compile_time
=
ct
})];
Nothing
->
...
...
@@ -223,7 +225,7 @@ parse_compile_time prog mod (l:ls) =
read_mut
=
read
mut
read_gc
=
read
gc
time
=
(
read
init
+
read_mut
+
read_gc
)
::
Float
ct
=
addToFM
emptyFM
mod
time
ct
=
Map
.
singleton
mod
time
in
[(
prog
,
emptyResults
{
compile_time
=
ct
})];
Nothing
->
...
...
@@ -234,7 +236,7 @@ parse_compile_time prog mod (l:ls) =
read_mut
=
read
mut
read_gc
=
read
gc
time
=
(
read
init
+
read_mut
+
read_gc
)
::
Float
ct
=
addToFM
emptyFM
mod
time
ct
=
Map
.
singleton
mod
time
in
[(
prog
,
emptyResults
{
compile_time
=
ct
})];
Nothing
->
...
...
@@ -245,7 +247,7 @@ parse_compile_time prog mod (l:ls) =
read_mut
=
read
mut
read_gc
=
read
gc
time
=
(
read
init
+
read_mut
+
read_gc
)
::
Float
ct
=
addToFM
emptyFM
mod
time
ct
=
Map
.
singleton
mod
time
in
[(
prog
,
emptyResults
{
compile_time
=
ct
})];
Nothing
->
...
...
@@ -368,7 +370,7 @@ parse_size prog mod (l:ls) =
Just
(
read
text
+
read
datas
),
compile_status
=
Success
})]
|
otherwise
->
let
ms
=
addToFM
emptyFM
mod
(
read
text
+
read
datas
)
let
ms
=
Map
.
singleton
mod
(
read
text
+
read
datas
)
in
[(
prog
,
emptyResults
{
module_size
=
ms
})]
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