import Type
import TyCon
import FiniteMap
+import PackageConfig
import Data.Array
import System.Time (ClockTime(..))
-- write the mix entries for this module
hashNo <- if opt_Hpc then do
let hpc_dir = hpcDir dflags
+
+ let hpc_mod_dir = if modulePackageId mod == mainPackageId
+ then hpc_dir
+ else hpc_dir ++ "/" ++ packageIdString (modulePackageId mod)
+
let tabStop = 1 -- <tab> counts as a normal char in GHC's location ranges.
- createDirectoryIfMissing True hpc_dir
+ createDirectoryIfMissing True hpc_mod_dir
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
+ mixCreate hpc_mod_dir mod_name
$ Mix orig_file modTime (toHash hashNo) tabStop entries'
return $ hashNo
else do
liftM2 ExplicitList
(return ty)
(mapM (addTickLHsExpr) es)
-addTickHsExpr (ExplicitPArr {}) = error "addTickHsExpr: ExplicitPArr"
+addTickHsExpr (ExplicitPArr ty es) =
+ liftM2 ExplicitPArr
+ (return ty)
+ (mapM (addTickLHsExpr) es)
addTickHsExpr (ExplicitTuple es box) =
liftM2 ExplicitTuple
(mapM (addTickLHsExpr) es)
(addTickHsRecordBinds rec_binds)
(return cons) (return tys1) (return tys2)
-addTickHsExpr (ExprWithTySig {}) = error "addTickHsExpr: ExprWithTySig"
addTickHsExpr (ExprWithTySigOut e ty) =
liftM2 ExprWithTySigOut
(addTickLHsExprNever e) -- No need to tick the inner expression
e2 <- allocTickBox (ExpBox False) pos $
addTickHsExpr e0
return $ unLoc e2
-addTickHsExpr (PArrSeq {}) = error "addTickHsExpr: PArrSeq"
-addTickHsExpr (HsSCC {}) = error "addTickHsExpr: HsSCC"
-addTickHsExpr (HsCoreAnn {}) = error "addTickHsExpr: HsCoreAnn"
+addTickHsExpr (PArrSeq ty arith_seq) =
+ liftM2 PArrSeq
+ (return ty)
+ (addTickArithSeqInfo arith_seq)
+addTickHsExpr (HsSCC nm e) =
+ liftM2 HsSCC
+ (return nm)
+ (addTickLHsExpr e)
+addTickHsExpr (HsCoreAnn nm e) =
+ liftM2 HsCoreAnn
+ (return nm)
+ (addTickLHsExpr e)
addTickHsExpr e@(HsBracket {}) = return e
addTickHsExpr e@(HsBracketOut {}) = return e
addTickHsExpr e@(HsSpliceE {}) = return e
addTickHsExpr e@(HsType ty) = return e
--- Should never happen in expression content.
-addTickHsExpr (EAsPat _ _) = error "addTickHsExpr: EAsPat _ _"
-addTickHsExpr (ELazyPat _) = error "addTickHsExpr: ELazyPat _"
-addTickHsExpr (EWildPat) = error "addTickHsExpr: EWildPat"
-addTickHsExpr (HsBinTick _ _ _) = error "addTickhsExpr: HsBinTick _ _ _"
-addTickHsExpr (HsTick _ _ _) = error "addTickhsExpr: HsTick _ _"
+-- Others dhould never happen in expression content.
+addTickHsExpr e@(ExprWithTySig {}) = pprPanic "addTickHsExpr" (ppr e)
+addTickHsExpr e@(EAsPat _ _) = pprPanic "addTickHsExpr" (ppr e)
+addTickHsExpr e@(ELazyPat _) = pprPanic "addTickHsExpr" (ppr e)
+addTickHsExpr e@(EWildPat) = pprPanic "addTickHsExpr" (ppr e)
+addTickHsExpr e@(HsBinTick _ _ _) = pprPanic "addTickHsExpr" (ppr e)
+addTickHsExpr e@(HsTick _ _ _) = pprPanic "addTickHsExpr" (ppr e)
addTickMatchGroup (MatchGroup matches ty) = do
let isOneOfMany = matchesOneOfMany matches