hpc-tools: improving flag processing and help messages, small bug fixes.

10 files changed, 311 insertions, 86 deletions

diff --git a/utils/hpc/Hpc.hs b/utils/hpc/Hpc.hs
index 08a4285073..e22556efa3 100644
--- a/utils/hpc/Hpc.hs
+++ b/utils/hpc/Hpc.hs
@@ -1,6 +1,7 @@
 -- (c) 2007 Andy Gill
 
 -- Main driver for Hpc
+import Trace.Hpc.Tix
 import HpcFlags
 import System.Environment
 import System.Exit
@@ -11,6 +12,7 @@ import HpcMarkup
 import HpcCombine
 import HpcShowTix
 import HpcDraft
+import HpcOverlay
 
 helpList :: IO ()
 helpList =
@@ -48,11 +50,11 @@ dispatch [] = do
 	     exitWith ExitSuccess
 dispatch (txt:args) = do
      case lookup txt hooks' of
-       Just plugin -> parse plugin
-       _ -> parse help_plugin
+       Just plugin -> parse plugin args
+       _ -> parse help_plugin (txt:args)
   where
-     parse plugin =
-              case getOpt Permute (options plugin) args of
+     parse plugin args =
+              case getOpt Permute (options plugin []) args of
                 (_,_,errs) | not (null errs)
                      -> do putStrLn "hpc failed:"
                 	   sequence [ putStr ("  " ++ err)
@@ -62,7 +64,8 @@ dispatch (txt:args) = do
                            command_usage plugin
           		   exitFailure
 	        (o,ns,_) -> do
-			 let flags = foldr (.) (final_flags plugin) o 
+			 let flags = final_flags plugin 
+			           $ foldr (.) id o 
 			     	   $ init_flags plugin
 			 implementation plugin flags ns
 main = do 
@@ -76,6 +79,7 @@ hooks = [ help_plugin
 	, markup_plugin
 	, combine_plugin
 	, showtix_plugin
+	, overlay_plugin
 	, draft_plugin
 	, version_plugin
         ]
@@ -105,14 +109,14 @@ help_main flags (sub_txt:_) = do
 	  command_usage plugin'
 	  exitWith ExitSuccess
 
-help_options   = []
+help_options   = id
 
 ------------------------------------------------------------------------------
 
 version_plugin = Plugin { name = "version"
 		   , usage = ""
 		   , summary = "Display version for hpc"
-		   , options = []
+		   , options = id
 		   , implementation = version_main
 		   , init_flags = default_flags
 		   , final_flags = default_final_flags
@@ -121,4 +125,4 @@ version_plugin = Plugin { name = "version"
 version_main _ _ = putStrLn $ "hpc tools, version 0.5-dev"
 
 
-------------------------------------------------------------------------------
+------------------------------------------------------------------------------
\ No newline at end of file
diff --git a/utils/hpc/HpcCombine.hs b/utils/hpc/HpcCombine.hs
index 9788c41259..ea23ab982d 100644
--- a/utils/hpc/HpcCombine.hs
+++ b/utils/hpc/HpcCombine.hs
@@ -13,10 +13,16 @@ import HpcFlags
 import Control.Monad
 import qualified HpcSet as Set
 import qualified HpcMap as Map
+import System.Environment
 
 ------------------------------------------------------------------------------
-combine_options = 
-  [ excludeOpt,includeOpt,outputOpt,combineFunOpt, combineFunOptInfo, postInvertOpt ]
+combine_options 
+        = excludeOpt
+        . includeOpt
+        . outputOpt
+        . combineFunOpt
+        . combineFunOptInfo
+        . postInvertOpt
        	 
 combine_plugin = Plugin { name = "combine"
 	      	       , usage = "[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]" 
diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs
index 4391bd0e0d..36256fc261 100644
--- a/utils/hpc/HpcDraft.hs
+++ b/utils/hpc/HpcDraft.hs
@@ -9,12 +9,17 @@ import HpcFlags
 import Control.Monad
 import qualified HpcSet as Set
 import qualified HpcMap as Map
+import System.Environment
 import HpcUtils
 import Data.Tree
 
 ------------------------------------------------------------------------------
-draft_options = 
-  [ excludeOpt,includeOpt,hpcDirOpt,hsDirOpt,outputOpt ]
+draft_options 
+        = excludeOpt
+        . includeOpt
+        . srcDirOpt
+        . hpcDirOpt
+        . outputOpt
        	 
 draft_plugin = Plugin { name = "draft"
 	      	       , usage = "[OPTION] .. <TIX_FILE>" 
@@ -54,7 +59,7 @@ makeDraft hpcflags tix = do
       hash = tixModuleHash tix
       tixs = tixModuleTixs tix
 
-  mix@(Mix filepath timestamp hash tabstop entries) <- readMix (hpcDirs hpcflags) mod
+  mix@(Mix filepath timestamp hash tabstop entries) <- readMixWithFlags hpcflags mod
 
   let forest = createMixEntryDom 
               [ (span,(box,v > 0))
@@ -66,7 +71,7 @@ makeDraft hpcflags tix = do
 
   let non_ticked = findNotTickedFromList forest
 
-  hs  <- readFileFromPath filepath (hsDirs hpcflags)
+  hs  <- readFileFromPath filepath (srcDirs hpcflags)
 
   let hsMap :: Map.Map Int String
       hsMap = Map.fromList (zip [1..] $ lines hs)
@@ -79,10 +84,10 @@ makeDraft hpcflags tix = do
 
   let showPleaseTick :: Int -> PleaseTick -> String
       showPleaseTick d (TickFun str pos) =
-                     spaces d ++ "tick function \"" ++ head str ++ "\" "
+                     spaces d ++ "tick function \"" ++ last str ++ "\" "
                               ++ "on line " ++ show (firstLine pos) ++ ";"
       showPleaseTick d (TickExp pos) =
-                     spaces d ++ "tick expression "
+                     spaces d ++ "tick "
                               ++ if '\n' `elem` txt 
                                  then "at position " ++ show pos ++ ";"
                                  else quoteString txt ++ " "  ++ "on line " ++ show (firstLine pos) ++ ";"
@@ -91,7 +96,7 @@ makeDraft hpcflags tix = do
                   txt = grabHpcPos hsMap pos
 
       showPleaseTick d (TickInside [str] pos pleases) =
-                     spaces d ++ "function \"" ++ str ++ "\" {\n" ++
+                     spaces d ++ "inside \"" ++ str ++ "\" {\n" ++
                      showPleaseTicks (d + 2) pleases ++
                      spaces d ++ "}"
 
diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs
index 49ebb500f8..68bd861353 100644
--- a/utils/hpc/HpcFlags.hs
+++ b/utils/hpc/HpcFlags.hs
@@ -3,17 +3,19 @@
 module HpcFlags where
 
 import System.Console.GetOpt
+import Data.Maybe ( fromMaybe )
 import qualified HpcSet as Set
 import Data.Char
 import Trace.Hpc.Tix
+import Trace.Hpc.Mix
 import System.Exit
 
 data Flags = Flags 
   { outputFile		:: String
   , includeMods         :: Set.Set String
   , excludeMods         :: Set.Set String
-  , hsDirs		:: [String]
-  , hpcDirs		:: [String]
+  , hpcDir		:: String
+  , srcDirs		:: [String]
   , destDir		:: String
 
   , perModule 		:: Bool
@@ -31,8 +33,8 @@ default_flags = Flags
   { outputFile		= "-"
   , includeMods         = Set.empty
   , excludeMods         = Set.empty
-  , hpcDirs             = []
-  , hsDirs              = []
+  , hpcDir              = ".hpc"
+  , srcDirs             = []
   , destDir             = "."
 
   , perModule           = False
@@ -50,37 +52,45 @@ default_flags = Flags
 -- depends on if specific flags we used.
 
 default_final_flags flags = flags 
-  { hpcDirs = if null (hpcDirs flags)
-    	      then [".hpc"]
-	      else hpcDirs flags
-  , hsDirs = if null (hsDirs flags)
+  { srcDirs = if null (srcDirs flags)
     	      then ["."]
-	      else hsDirs flags
+	      else srcDirs flags
   }
 
-noArg :: String -> String -> (Flags -> Flags) -> OptDescr (Flags -> Flags)
-noArg flag detail fn = Option [] [flag] (NoArg $ fn) detail
+type FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)]
 
-anArg :: String -> String -> String -> (String -> Flags -> Flags) -> OptDescr (Flags -> Flags)
-anArg flag detail argtype fn = Option [] [flag] (ReqArg fn argtype) detail
+noArg :: String -> String -> (Flags -> Flags) -> FlagOptSeq
+noArg flag detail fn = (:) $ Option [] [flag] (NoArg $ fn) detail
 
-infoArg :: String -> OptDescr (Flags -> Flags)
-infoArg info = Option [] [] (NoArg $ id) info
+anArg :: String -> String -> String -> (String -> Flags -> Flags) -> FlagOptSeq
+anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail
 
-excludeOpt    = anArg "exclude"    "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"  $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
+infoArg :: String -> FlagOptSeq
+infoArg info = (:) $ Option [] [] (NoArg $ id) info
 
-includeOpt    = anArg "include"    "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"  $ \ a f -> f { includeMods = a `Set.insert` includeMods f }
-hpcDirOpt     = anArg "hpcdir"     "path to .mix files (default .hpc)" "DIR"
-	      	      		   	 		      $ \ a f -> f { hpcDirs = hpcDirs f ++ [a] }
-hsDirOpt      = anArg "hsdir"     "path to .hs files (default .)" "DIR"
-	      	      		   	 		      $ \ a f -> f { hsDirs = hsDirs f ++ [a] }
-destDirOpt    = anArg "destdir"   "path to write output to" "DIR"
-	      	      		  	   	 	      $ \ a f -> f { destDir = a }
+excludeOpt      = anArg "exclude"    "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"  
+                $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
+
+includeOpt      = anArg "include"    "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"  
+                $ \ a f -> f { includeMods = a `Set.insert` includeMods f }
+
+hpcDirOpt        = anArg "hpcdir"     "sub-directory that contains .mix files" "DIR"
+                   (\ a f -> f { hpcDir = a })
+                .  infoArg "default .hpc [rarely used]"
+
+srcDirOpt       = anArg "srcdir"     "path to source directory of .hs files" "DIR"
+	          (\ a f -> f { srcDirs = srcDirs f ++ [a] })
+	        . infoArg "multi-use of srcdir possible"
+	        
+destDirOpt      = anArg "destdir"   "path to write output to" "DIR"
+	        $ \ a f -> f { destDir = a }
+
+	        
 outputOpt     = anArg "output"    "output FILE" "FILE"        $ \ a f -> f { outputFile = a }
 -- markup
 
 perModuleOpt  = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True }
-decListOpt    = noArg "dec-list"   "show unused decls"	      $ \ f -> f { decList = True }
+decListOpt    = noArg "decl-list"  "show unused decls"	      $ \ f -> f { decList = True }
 xmlOutputOpt  = noArg "xml-output" "show output in XML"       $ \ f -> f { xmlOutput = True }  
 funTotalsOpt  = noArg "fun-entry-count" "show top-level function entry counts"      
 							      $ \ f -> f { funTotals = True }  
@@ -100,13 +110,19 @@ postInvertOpt = noArg "post-invert" "invert output; ticked becomes unticked, unt
 							      $ \ f -> f { funTotals = True }  
 -------------------------------------------------------------------------------
 
+readMixWithFlags flags mod = readMix [ dir ++  "/" ++ hpcDir flags
+                                     | dir <- srcDirs flags 
+                                     ] mod
+
+-------------------------------------------------------------------------------
+
 command_usage plugin = 
   putStrLn $
 				       "Usage: hpc " ++ (name plugin) ++ " " ++ 
 				        (usage plugin) ++
-				        if null (options plugin)
+				        if null (options plugin [])
 				        then ""
-  	                                else usageInfo "\n\nOptions:\n" (options plugin)
+  	                                else usageInfo "\n\nOptions:\n" (options plugin [])
 
 hpcError :: Plugin -> String -> IO a
 hpcError plugin msg = do
@@ -118,7 +134,7 @@ hpcError plugin msg = do
 
 data Plugin = Plugin { name           :: String
      	             , usage          :: String
-		     , options        :: [OptDescr (Flags -> Flags)]
+		     , options        :: FlagOptSeq
 		     , summary        :: String
 		     , implementation :: Flags -> [String] -> IO ()
 		     , init_flags     :: Flags
@@ -135,15 +151,16 @@ data Plugin = Plugin { name           :: String
 
 allowModule :: Flags -> String -> Bool
 allowModule flags full_mod 
-      | full_mod `Set.member` excludeMods flags = False
-      | pkg_name `Set.member` excludeMods flags = False
-      | mod_name `Set.member` excludeMods flags = False
-      | Set.null (includeMods flags)            = True
-      | full_mod `Set.member` includeMods flags = True
-      | pkg_name `Set.member` includeMods flags = True
-      | mod_name `Set.member` includeMods flags = True
-      | otherwise	 	       	        = False
+      | full_mod' `Set.member` excludeMods flags = False
+      | pkg_name  `Set.member` excludeMods flags = False
+      | mod_name  `Set.member` excludeMods flags = False
+      | Set.null (includeMods flags)             = True
+      | full_mod' `Set.member` includeMods flags = True
+      | pkg_name  `Set.member` includeMods flags = True
+      | mod_name  `Set.member` includeMods flags = True
+      | otherwise	 	       	         = False
   where
+          full_mod' = pkg_name ++ mod_name
       -- pkg name always ends with '/', main 
 	  (pkg_name,mod_name) = 
 			case span (/= '/') full_mod of
diff --git a/utils/hpc/HpcLexer.hs b/utils/hpc/HpcLexer.hs
new file mode 100644
index 0000000000..74bec5dd4c
--- /dev/null
+++ b/utils/hpc/HpcLexer.hs
@@ -0,0 +1,45 @@
+module HpcLexer where
+
+import Data.Char
+
+data Token 
+	= ID String
+        | SYM Char
+        | INT Int
+        | STR String
+	deriving (Eq,Show)
+
+initLexer :: String -> [Token]
+initLexer str = [ t | (_,_,t) <- lexer str 1 0 ]
+
+lexer :: String -> Int -> Int ->  [(Int,Int,Token)]
+lexer (c:cs) line column
+  | c == '\n' = lexer cs (succ line) 0
+  | c == '\"' = lexerSTR cs line (succ column)
+  | c `elem` "{};-:" 
+              = (line,column,SYM c) : lexer cs line (succ column)
+  | isSpace c = lexer cs        line (succ column)
+  | isAlpha c = lexerKW  cs [c] line (succ column)
+  | isDigit c = lexerINT cs [c] line (succ column)
+  | otherwise = error "lexer failure"
+lexer [] line colunm = []
+
+lexerKW  (c:cs) s line column
+  | isAlpha c = lexerKW cs (s ++ [c]) line (succ column)
+lexerKW  other s line column = (line,column,ID s) : lexer other line column
+
+lexerINT  (c:cs) s line column
+  | isDigit c = lexerINT cs (s ++ [c]) line (succ column)
+lexerINT  other s line column = (line,column,INT (read s)) : lexer other line column
+
+-- not technically correct for the new column count, but a good approximation.
+lexerSTR cs line column
+  = case lex ('"' : cs) of
+      [(str,rest)] -> (line,succ column,STR str) 
+                   : lexer rest line (length (show str) + column + 1)
+      _ -> error "bad string"
+
+test = do
+          t <- readFile "EXAMPLE.tc"
+          print (initLexer t)
+          
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index d4f4ee6587..4b3b976f5a 100644
--- a/utils/hpc/HpcMarkup.hs
+++ b/utils/hpc/HpcMarkup.hs
@@ -11,6 +11,7 @@ import Trace.Hpc.Util
 
 import HpcFlags
 
+import System.Environment
 import System.Directory
 import Data.List
 import Data.Maybe(fromJust)
@@ -19,13 +20,14 @@ import qualified HpcSet as Set
 
 ------------------------------------------------------------------------------
 
-markup_options = 
-  [ excludeOpt,includeOpt,hpcDirOpt,hsDirOpt,funTotalsOpt
-  , altHighlightOpt
-#if __GLASGOW_HASKELL__ >= 604 
-  , destDirOpt
-#endif
-  ]
+markup_options 
+        = excludeOpt
+        . includeOpt
+        . srcDirOpt
+        . hpcDirOpt
+        . funTotalsOpt
+        . altHighlightOpt
+        . destDirOpt
        	 
 markup_plugin = Plugin { name = "markup"
 	      	       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]" 
@@ -45,16 +47,14 @@ markup_main flags (prog:modNames) = do
   	      	     	 	   `Set.union` 
 				includeMods flags }
   let Flags
-       { hpcDirs = hpcDirs
-       , hsDirs = theHsPath
-       , funTotals = theFunTotals
+       { funTotals = theFunTotals
        , altHighlight = invertOutput
        , destDir = dest_dir
        }  = hpcflags1
 
   mtix <- readTix (getTixFileName prog)
   Tix tixs <- case mtix of
-    Nothing -> error $ "unable to find tix file for: " ++ prog
+    Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog
     Just a -> return a
 
 #if __GLASGOW_HASKELL__ >= 604 
@@ -63,7 +63,7 @@ markup_main flags (prog:modNames) = do
 #endif
 
   mods <-
-     sequence [ genHtmlFromMod dest_dir hpcDirs tix theFunTotals theHsPath invertOutput
+     sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput
 	      | tix <- tixs
 	      , allowModule hpcflags1 (tixModuleName tix)
    	      ]
@@ -130,20 +130,20 @@ markup_main flags (prog:modNames) = do
 		(percent (expTicked s1) (expTotal s1))
 
 
-markup_main flags [] = error $ "no .tix file or executable name specified" 
+markup_main flags [] = hpcError markup_plugin $ "no .tix file or executable name specified" 
 
 genHtmlFromMod
   :: String
-  -> [FilePath]
+  -> Flags
   -> TixModule
   -> Bool
-  -> [String]
   -> Bool
   -> IO (String, [Char], ModuleSummary)
-genHtmlFromMod dest_dir hpcDirs tix theFunTotals theHsPath invertOutput = do
+genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
+  let theHsPath = srcDirs flags
   let modName0 = tixModuleName tix 
 
-  (Mix origFile _ mixHash tabStop mix') <- readMix hpcDirs modName0
+  (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags modName0
 
   let arr_tix :: Array Int Integer
       arr_tix = listArray (0,length (tixModuleTixs tix) - 1)
@@ -457,7 +457,8 @@ readFileFromPath filename@('/':_) _ = readFile filename
 readFileFromPath filename path0 = readTheFile path0
   where
 	readTheFile :: [String] -> IO String
-	readTheFile [] = error $ "could not find " ++ show filename 
+	readTheFile [] = hpcError markup_plugin
+	                     $ "could not find " ++ show filename 
 			         ++ " in path " ++ show path0
 	readTheFile (dir:dirs) = 
 		catch (do str <- readFile (dir ++ "/" ++ filename) 
diff --git a/utils/hpc/HpcOverlay.hs b/utils/hpc/HpcOverlay.hs
new file mode 100644
index 0000000000..ba229c5ef5
--- /dev/null
+++ b/utils/hpc/HpcOverlay.hs
@@ -0,0 +1,28 @@
+module HpcOverlay where
+
+import HpcFlags
+import HpcParser
+
+overlay_options 
+        = srcDirOpt
+        . hpcDirOpt
+        . outputOpt
+
+overlay_plugin = Plugin { name = "overlay"
+	      	       , usage = "[OPTION] .. <OVERLAY_FILE> [<OVERLAY_FILE> [...]]" 
+		       , options = overlay_options 
+		       , summary = "Generate a .tix file from an overlay file"
+		       , implementation = overlay_main
+		       , init_flags = default_flags
+		       , final_flags = default_final_flags
+		       }
+
+
+overlay_main flags [] = hpcError overlay_plugin $ "no overlay file specified" 
+overlay_main flags files = do
+  print ("HERE", files)
+  result <- hpcParser (head files)
+  print result
+  return ()
+  
+  
diff --git a/utils/hpc/HpcParser.y b/utils/hpc/HpcParser.y
new file mode 100644
index 0000000000..a6a095b9ab
--- /dev/null
+++ b/utils/hpc/HpcParser.y
@@ -0,0 +1,106 @@
+{ 
+module HpcParser where
+
+import HpcLexer
+}
+
+%name parser
+%tokentype { Token }
+%error { \ e -> error $ show (take 10 e) }
+
+%token
+	MODULE 		{ ID "module" }
+	TICK		{ ID "tick" }
+	EXPRESSION	{ ID "expression" }
+	ON		{ ID "on" }
+	LINE		{ ID "line" }
+	POSITION	{ ID "position" }
+	FUNCTION	{ ID "function" }
+	INSIDE          { ID "inside" }
+	AT		{ ID "at" }
+	':'		{ SYM ':' }
+	'-'		{ SYM '-' }
+	';'		{ SYM ';' }
+	'{'		{ SYM '{' }
+	'}'		{ SYM '}' }
+	int		{ INT $$ }
+	string		{ STR $$ }
+	cat		{ STR $$ }
+%%
+
+Spec    :: { Spec }
+Spec 	: Ticks Modules 	{ Spec ($1 []) ($2 []) }
+
+Modules :: { L (ModuleName,[Tick]) }
+Modules	: Modules Module	{ $1 . ((:) $2) }
+	|			{ id }
+	
+Module :: { (ModuleName,[Tick]) }
+Module  : MODULE string '{' TopTicks '}'
+				{ ($2,$4 []) }
+
+TopTicks :: { L Tick }
+TopTicks : TopTicks TopTick	{ $1 . ((:) $2) }
+	 | 			{ id }
+	
+TopTick :: { Tick }
+TopTick : Tick			{ ExprTick $1 }
+	| TICK FUNCTION string optQual optCat ';'
+				{ TickFunction $3 $4 $5 }
+	| INSIDE string '{' TopTicks '}'
+				{ InsideFunction $2 ($4 []) }
+				 
+Ticks   :: { L ExprTick }
+Ticks   : Ticks  Tick          	{ $1 . ((:) $2) }
+	|  		       	{ id } 
+	
+Tick   :: { ExprTick }
+Tick    : TICK optString optQual optCat ';'
+				{ TickExpression False $2 $3 $4 }
+
+optString :: { Maybe String }
+optString : string		{ Just $1 }
+	  |			{ Nothing }
+	
+optQual :: { Maybe Qualifier }
+optQual : ON LINE int 		{ Just (OnLine $3) }
+	| AT POSITION int ':' int '-' int ':' int
+				{ Just (AtPosition $3 $5 $7 $9) }
+	| 			{ Nothing }
+optCat  :: { Maybe String }
+optCat  : cat			{ Just $1 }
+	| 			{ Nothing }
+
+{
+type L a = [a] -> [a]
+	
+type ModuleName = String
+
+data Spec 
+  = Spec [ExprTick] [(ModuleName,[Tick])]
+   deriving (Show)
+
+data ExprTick
+  = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String)
+   deriving (Show)
+
+data Tick
+  = ExprTick ExprTick
+  | TickFunction   String (Maybe Qualifier) (Maybe String)
+  | InsideFunction String [Tick]
+   deriving (Show)
+
+data Qualifier = OnLine Int
+               | AtPosition Int Int Int Int
+   deriving (Show)             
+
+
+
+hpcParser :: String -> IO Spec
+hpcParser filename = do
+  txt <- readFile filename
+  let tokens = initLexer txt
+  return $ parser tokens  	
+
+
+}
diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs
index 2fa79f60d7..2950cbf253 100644
--- a/utils/hpc/HpcReport.hs
+++ b/utils/hpc/HpcReport.hs
@@ -5,7 +5,9 @@
 
 module HpcReport (report_plugin) where
 
+import System.Exit
 import Prelude hiding (exp)
+import System(getArgs)
 import List(sort,intersperse)
 import HpcFlags
 import Trace.Hpc.Mix
@@ -150,7 +152,7 @@ single (BinBox {}) = False
 
 modInfo :: Flags -> Bool -> (String,[Integer]) -> IO ModInfo
 modInfo hpcflags qualDecList (moduleName,tickCounts) = do
-  Mix _ _ _ _ mes <- readMix (hpcDirs hpcflags) moduleName
+  Mix _ _ _ _ mes <- readMixWithFlags hpcflags moduleName
   return (q (accumCounts (zip (map snd mes) tickCounts) miZero))
   where
   q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)}
@@ -223,9 +225,9 @@ report_main hpcflags (progName:mods) = do
 	   	      | TixModule m _h _ tcs <- tickCounts
 		      , allowModule hpcflags1 m 
 		      ]
-    Nothing -> error $ "unable to find tix file for:" ++ progName
-
-
+    Nothing -> hpcError report_plugin  $ "unable to find tix file for:" ++ progName
+report_main hpcflags [] = 
+        hpcError report_plugin $ "no .tix file or executable name specified" 
 
 makeReport :: Flags -> String -> [(String,[Integer])] -> IO ()
 makeReport hpcflags progName modTcs | xmlOutput hpcflags = do
@@ -259,5 +261,13 @@ xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),(
 
 ------------------------------------------------------------------------------
 
-report_options = [perModuleOpt,decListOpt,excludeOpt,includeOpt,hpcDirOpt,xmlOutputOpt]
+report_options 
+        = perModuleOpt
+        . decListOpt
+        . excludeOpt
+        . includeOpt
+        . srcDirOpt
+        . hpcDirOpt
+        . xmlOutputOpt
+        
 
diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs
index 4ed07fd892..c353e1b278 100644
--- a/utils/hpc/HpcShowTix.hs
+++ b/utils/hpc/HpcShowTix.hs
@@ -2,15 +2,18 @@ module HpcShowTix (showtix_plugin) where
 
 import Trace.Hpc.Mix
 import Trace.Hpc.Tix
+import Trace.Hpc.Util
 
 import HpcFlags
 
 import qualified HpcSet as Set
 
-showtix_options = 
-  [ excludeOpt,includeOpt,hpcDirOpt
-  , outputOpt
-  ]
+showtix_options 
+        = excludeOpt
+        . includeOpt
+        . srcDirOpt
+        . hpcDirOpt
+        . outputOpt
 
 showtix_plugin = Plugin { name = "show"
 	      	       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]" 
@@ -34,12 +37,11 @@ showtix_main flags (prog:modNames) = do
   case optTixs of
     Nothing -> hpcError showtix_plugin $ "could not read .tix file : "  ++ prog
     Just (Tix tixs) -> do
-       let modules = map tixModuleName tixs       
-
-       mixs <- sequence
-               [ readMix (hpcDirs hpcflags1) modName            -- hard wired to .hpc for now
-               | modName <- modules
-	       , allowModule hpcflags1 modName
+       tixs_mixs <- sequence
+               [ do mix <- readMixWithFlags hpcflags1 (tixModuleName tix) 
+                    return $ (tix,mix)
+               | tix <- tixs
+	       , allowModule hpcflags1 (tixModuleName tix)
                ]
      
        let rjust n str = take (n - length str) (repeat ' ') ++ str 
@@ -52,7 +54,8 @@ showtix_main flags (prog:modNames) = do
                              ]
                  | ( TixModule modName hash _ tixs
                    , Mix _file _timestamp _hash _tab entries
-                   ) <- zip tixs mixs
+                   ) <- tixs_mixs
                  ]
        
        return ()
+