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
858a055d
Commit
858a055d
authored
Jun 29, 2007
by
andy@galois.com
Browse files
Fixing hpc tools for 6.2 and 6.4
parent
283705da
Changes
8
Hide whitespace changes
Inline
Side-by-side
utils/hpc/Hpc.hs
View file @
858a055d
...
...
@@ -116,4 +116,4 @@ version_plugin = Plugin { name = "version"
version_main
_
_
=
putStrLn
$
"hpc tools, version 0.5-dev"
------------------------------------------------------------------------------
\ No newline at end of file
------------------------------------------------------------------------------
utils/hpc/HpcCombine.hs
View file @
858a055d
...
...
@@ -11,9 +11,8 @@ import Trace.Hpc.Util
import
HpcFlags
import
Control.Monad
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
import
qualified
HpcSet
as
Set
import
qualified
HpcMap
as
Map
import
System.Environment
------------------------------------------------------------------------------
...
...
utils/hpc/HpcFlags.hs
View file @
858a055d
...
...
@@ -4,7 +4,7 @@ module HpcFlags where
import
System.Console.GetOpt
import
Data.Maybe
(
fromMaybe
)
import
qualified
Data.
Set
as
Set
import
qualified
Hpc
Set
as
Set
import
Data.Char
import
Trace.Hpc.Tix
...
...
utils/hpc/HpcMap.hs
0 → 100644
View file @
858a055d
module
HpcMap
(
module
HpcMap
)
where
#
if
__GLASGOW_HASKELL__
<
604
import
qualified
Data.FiniteMap
as
Map
#
else
import
qualified
Data.Map
as
Map
#
endif
lookup
::
Ord
key
=>
key
->
Map
key
elt
->
Maybe
elt
fromList
::
Ord
key
=>
[(
key
,
elt
)]
->
Map
key
elt
#
if
__GLASGOW_HASKELL__
<
604
type
Map
key
elt
=
Map
.
FiniteMap
key
elt
lookup
=
flip
Map
.
lookupFM
fromList
=
Map
.
listToFM
#
else
type
Map
key
elt
=
Map
.
Map
key
elt
lookup
=
Map
.
lookup
fromList
=
Map
.
fromList
#
endif
utils/hpc/HpcMarkup.hs
View file @
858a055d
...
...
@@ -16,14 +16,16 @@ import System.Directory
import
Data.List
import
Data.Maybe
(
fromJust
)
import
Data.Array
import
qualified
Data.
Set
as
Set
import
qualified
Hpc
Set
as
Set
------------------------------------------------------------------------------
markup_options
=
[
excludeOpt
,
includeOpt
,
hpcDirOpt
,
hsDirOpt
,
funTotalsOpt
,
altHighlightOpt
#
if
__GLASGOW_HASKELL__
>=
604
,
destDirOpt
#
endif
]
markup_plugin
=
Plugin
{
name
=
"markup"
...
...
@@ -56,8 +58,10 @@ markup_main flags (prog:modNames) = do
Nothing
->
error
$
"unable to find tix file for: "
++
prog
Just
a
->
return
a
#
if
__GLASGOW_HASKELL__
>=
604
-- create the dest_dir if needed
createDirectoryIfMissing
True
dest_dir
#
endif
mods
<-
sequence
[
genHtmlFromMod
dest_dir
hpcDirs
tix
theFunTotals
theHsPath
invertOutput
...
...
utils/hpc/HpcReport.hs
View file @
858a055d
...
...
@@ -13,7 +13,7 @@ import HpcFlags
import
Trace.Hpc.Mix
import
Trace.Hpc.Tix
import
Control.Monad
hiding
(
guard
)
import
qualified
Data.
Set
as
Set
import
qualified
Hpc
Set
as
Set
notExpecting
::
String
->
a
notExpecting
s
=
error
(
"not expecting "
++
s
)
...
...
utils/hpc/HpcSet.hs
0 → 100644
View file @
858a055d
module
HpcSet
(
module
HpcSet
)
where
import
qualified
Data.Set
as
Set
type
Set
a
=
Set
.
Set
a
empty
::
Set
a
insert
::
(
Ord
a
)
=>
a
->
Set
a
->
Set
a
member
::
(
Ord
a
)
=>
a
->
Set
a
->
Bool
null
::
Set
a
->
Bool
intersection
::
Ord
a
=>
Set
a
->
Set
a
->
Set
a
fromList
::
Ord
a
=>
[
a
]
->
Set
a
toList
::
Set
a
->
[
a
]
union
::
Ord
a
=>
Set
a
->
Set
a
->
Set
a
#
if
__GLASGOW_HASKELL__
<
604
empty
=
Set
.
emptySet
insert
=
flip
Set
.
addToSet
member
=
Set
.
elementOf
null
=
Set
.
isEmptySet
intersection
=
Set
.
intersect
fromList
=
Set
.
mkSet
toList
=
Set
.
setToList
union
=
Set
.
union
#
else
empty
=
Set
.
empty
insert
=
Set
.
insert
member
=
Set
.
member
null
=
Set
.
null
intersection
=
Set
.
intersection
fromList
=
Set
.
fromList
toList
=
Set
.
toList
union
=
Set
.
union
#
endif
utils/hpc/Makefile
View file @
858a055d
...
...
@@ -6,7 +6,7 @@ INSTALL_PROGS += $(HS_PROG)
HPC_LIB
=
$(TOP)
/libraries/hpc
include
$(GHC_COMPAT_DIR)/compat.mk
SRC_HC_OPTS
+=
$(PACKAGE_HPC)
SRC_HC_OPTS
+=
$(PACKAGE_HPC)
-cpp
binary-dist
:
$(INSTALL_DIR)
$(BIN_DIST_DIR)
/utils/hpc
...
...
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