From a171dac28baada2036577e7b0b4d7cc1c6836952 Mon Sep 17 00:00:00 2001 From: "andy@galois.com" Date: Fri, 22 Jun 2007 22:40:38 +0000 Subject: [PATCH] Stage2 now used the package hpc to get the hpc datastructures Stage1 no longer supports hpc (-fhpc is ignored) --- compiler/Makefile | 6 +-- compiler/deSugar/Coverage.lhs | 89 +++++++++-------------------------------- 2 files changed, 22 insertions(+), 73 deletions(-) diff --git a/compiler/Makefile b/compiler/Makefile index e4860ea..c832f43 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -406,15 +406,15 @@ endif # ----------------------------------------------------------------------------- # Building a compiler with interpreter support # -# The interpreter, GHCi interface, and Template Haskell are only +# The interpreter, GHCi interface, Template Haskell and Hpc are only # enabled when we are bootstrapping with the same version of GHC, and # the interpreter is supported on this platform. ifeq "$(GhcWithInterpreter) $(bootstrapped)" "YES YES" # Yes, include the interepreter, readline, and Template Haskell extensions -SRC_HC_OPTS += -DGHCI -package template-haskell -PKG_DEPENDS += template-haskell +SRC_HC_OPTS += -DGHCI -package template-haskell -package hpc +PKG_DEPENDS += template-haskell hpc # Should GHCI be building info tables in the TABLES_NEXT_TO_CODE style # or not? diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 116d3bf..501ee81 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -31,7 +31,6 @@ import FiniteMap import Data.Array import System.Time (ClockTime(..)) -import System.Directory (getModificationTime) import System.IO (FilePath) #if __GLASGOW_HASKELL__ < 603 import Compat.Directory ( createDirectoryIfMissing ) @@ -39,6 +38,11 @@ import Compat.Directory ( createDirectoryIfMissing ) import System.Directory ( createDirectoryIfMissing ) #endif +#if GHCI +import Trace.Hpc.Mix +import Trace.Hpc.Util +#endif + import BreakArray import Data.HashTable ( hashString ) \end{code} @@ -59,7 +63,9 @@ addCoverageTicksToBinds -> LHsBinds Id -> IO (LHsBinds Id, HpcInfo, ModBreaks) +#if GHCI addCoverageTicksToBinds dflags mod mod_loc tyCons binds = do + let orig_file = case ml_hs_file mod_loc of Just file -> file @@ -90,13 +96,13 @@ addCoverageTicksToBinds dflags mod mod_loc tyCons binds = do let hpc_dir = hpcDir dflags let tabStop = 1 -- counts as a normal char in GHC's location ranges. createDirectoryIfMissing True hpc_dir - modTime <- getModificationTime' orig_file + modTime <- getModificationTime orig_file let entries' = [ (hpcPos, box) | (span,_,box) <- entries, hpcPos <- [mkHpcPos span] ] when (length entries' /= tickBoxCount st) $ do panic "the number of .mix entries are inconsistent" let hashNo = mixHash orig_file modTime tabStop entries' - mixCreate hpc_dir mod_name (Mix orig_file modTime hashNo tabStop entries') + mixCreate hpc_dir mod_name (Mix orig_file modTime (toHash hashNo) tabStop entries') return $ hashNo else do return $ 0 @@ -524,7 +530,7 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) = \begin{code} data TickTransState = TT { tickBoxCount:: Int - , mixEntries :: [MixEntry] + , mixEntries :: [MixEntry_] } data TickTransEnv = TTE { modName :: String @@ -697,37 +703,7 @@ matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1 \begin{code} --- | 'Mix' is the information about a modules static properties, like --- location of Tix's in a file. --- tab stops are the size of a tab in the provided line:colunm values. --- * In GHC, this is 1 (a tab is just a character) --- * With hpc-tracer, this is 8 (a tab represents several spaces). - -data Mix = Mix - FilePath -- ^location of original file - Integer -- ^time (in seconds) of original file's last update, since 1970. - Int -- ^hash of mix entry + timestamp - Int -- ^tab stop value. - [MixEntry_] -- ^entries - deriving (Show, Read) - --- We would rather use ClockTime in Mix, but ClockTime has no Read instance in 6.4 and before, --- but does in 6.6. Definining the instance for ClockTime here is the Wrong Thing to do, --- because if some other program also defined that instance, we will not be able to compile. - -type MixEntry = (SrcSpan, [OccName], BoxLabel) -type MixEntry_ = (HpcPos, BoxLabel) - -data BoxLabel = ExpBox Bool -- isAlt - | TopLevelBox [String] - | LocalBox [String] - | BinBox CondBox Bool - deriving (Read, Show, Eq, Ord) - -data CondBox = GuardBinBox - | CondBinBox - | QualBinBox - deriving (Read, Show, Eq, Ord) +type MixEntry_ = (SrcSpan, [OccName], BoxLabel) -- For the hash value, we hash everything: the file name, -- the timestamp of the original source file, the tab stop, @@ -735,42 +711,15 @@ data CondBox = GuardBinBox -- This hash only has to be hashed at Mix creation time, -- and is for sanity checking only. -mixHash :: FilePath -> Integer -> Int -> [MixEntry_] -> Int +mixHash :: FilePath -> Integer -> Int -> [MixEntry] -> Int mixHash file tm tabstop entries = fromIntegral $ hashString (show $ Mix file tm 0 tabstop entries) - -mixCreate :: String -> String -> Mix -> IO () -mixCreate dirName modName mix = - writeFile (mixName dirName modName) (show mix) - -mixName :: FilePath -> String -> String -mixName dirName name = dirName ++ "/" ++ name ++ ".mix" - -getModificationTime' :: FilePath -> IO Integer -getModificationTime' file = do - (TOD sec _) <- System.Directory.getModificationTime file - return $ sec - --- a program index records module names and numbers of tick-boxes --- introduced in each module that has been transformed for coverage - -data HpcPos = P !Int !Int !Int !Int deriving (Eq) - -toHpcPos :: (Int,Int,Int,Int) -> HpcPos -toHpcPos (l1,c1,l2,c2) = P l1 c1 l2 c2 - -instance Show HpcPos where - show (P l1 c1 l2 c2) = show l1 ++ ':' : show c1 ++ '-' : show l2 ++ ':' : show c2 - -instance Read HpcPos where - readsPrec _i pos = [(toHpcPos (read l1,read c1,read l2,read c2),after)] - where - (before,after) = span (/= ',') pos - (lhs,rhs) = case span (/= '-') before of - (lhs,'-':rhs) -> (lhs,rhs) - (lhs,"") -> (lhs,lhs) - (l1,':':c1) = span (/= ':') lhs - (l2,':':c2) = span (/= ':') rhs - \end{code} + +\begin{code} +#else +addCoverageTicksToBinds dflags mod mod_loc tyCons binds = + return (binds, noHpcInfo, emptyModBreaks) +#endif +\end{code} \ No newline at end of file -- 1.7.10.4