Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
8b6f1dbd
Commit
8b6f1dbd
authored
Jan 26, 2008
by
andy@galois.com
Browse files
Fix
#2062
: foldr1 problem in hpc tool
parent
fb236fbb
Changes
2
Hide whitespace changes
Inline
Side-by-side
utils/hpc/HpcMarkup.hs
View file @
8b6f1dbd
...
...
@@ -17,6 +17,7 @@ import System.Directory
import
Data.List
import
Data.Maybe
(
fromJust
)
import
Data.Array
import
Data.Monoid
import
qualified
HpcSet
as
Set
------------------------------------------------------------------------------
...
...
@@ -110,7 +111,7 @@ markup_main flags (prog:modNames) = do
|
(
modName
,
fileName
,
summary
)
<-
mods'
]
++
"<tr></tr>"
++
showTotalSummary
(
foldr1
combineSummary
showTotalSummary
(
mconcat
[
summary
|
(
_
,
_
,
summary
)
<-
mods'
])
...
...
@@ -197,14 +198,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
,
let
ticked
=
if
isTicked
gid
then
succ
else
id
]
$
ModuleSummary
{
expTicked
=
0
,
expTotal
=
0
,
topFunTicked
=
0
,
topFunTotal
=
0
,
altTicked
=
0
,
altTotal
=
0
}
]
$
mempty
-- add prefix to modName argument
content
<-
readFileFromPath
(
hpcError
markup_plugin
)
origFile
theHsPath
...
...
@@ -438,10 +432,19 @@ percent :: (Integral a) => a -> a -> Maybe a
percent
ticked
total
=
if
total
==
0
then
Nothing
else
Just
(
ticked
*
100
`
div
`
total
)
combineSummary
::
ModuleSummary
->
ModuleSummary
->
ModuleSummary
combineSummary
(
ModuleSummary
eTik1
eTot1
tTik1
tTot1
aTik1
aTot1
)
(
ModuleSummary
eTik2
eTot2
tTik2
tTot2
aTik2
aTot2
)
=
ModuleSummary
(
eTik1
+
eTik2
)
(
eTot1
+
eTot2
)
(
tTik1
+
tTik2
)
(
tTot1
+
tTot2
)
(
aTik1
+
aTik2
)
(
aTot1
+
aTot2
)
instance
Monoid
ModuleSummary
where
mempty
=
ModuleSummary
{
expTicked
=
0
,
expTotal
=
0
,
topFunTicked
=
0
,
topFunTotal
=
0
,
altTicked
=
0
,
altTotal
=
0
}
mappend
(
ModuleSummary
eTik1
eTot1
tTik1
tTot1
aTik1
aTot1
)
(
ModuleSummary
eTik2
eTot2
tTik2
tTot2
aTik2
aTot2
)
=
ModuleSummary
(
eTik1
+
eTik2
)
(
eTot1
+
eTot2
)
(
tTik1
+
tTik2
)
(
tTot1
+
tTot2
)
(
aTik1
+
aTik2
)
(
aTot1
+
aTot2
)
------------------------------------------------------------------------------
-- global color pallete
...
...
utils/hpc/HpcOverlay.hs
View file @
8b6f1dbd
...
...
@@ -138,9 +138,10 @@ qualifier pos (Just (AtPosition l1' c1' l2' c2'))
=
(
l1'
,
c1'
,
l2'
,
c2'
)
==
fromHpcPos
pos
concatSpec
::
[
Spec
]
->
Spec
concatSpec
=
foldl1
$
\
(
Spec
pre1
body1
)
(
Spec
pre2
body2
)
->
Spec
(
pre1
++
pre2
)
(
body1
++
body2
)
concatSpec
=
foldr
(
\
(
Spec
pre1
body1
)
(
Spec
pre2
body2
)
->
Spec
(
pre1
++
pre2
)
(
body1
++
body2
))
(
Spec
[]
[]
)
...
...
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