Commit 85900110 authored by andy@galois.com's avatar andy@galois.com
Browse files

Fixing Alts to reflect Alternatives, rather than every pattern match in Hpc.

parent 7c48f5e3
......@@ -122,7 +122,7 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do
let arg_count = matchGroupArity mg
let (tys,res_ty) = splitFunTysN arg_count ty
return $ L pos $ funBind { fun_matches = MatchGroup ({-L pos fn_entry:-}matches') ty
return $ L pos $ funBind { fun_matches = MatchGroup matches' ty
, fun_tick = tick_no
}
......@@ -289,7 +289,7 @@ addTickHsExpr (HsBinTick _ _ _) = error "addTickhsExpr: HsBinTick _ _ _"
addTickHsExpr (HsTick _ _) = error "addTickhsExpr: HsTick _ _"
addTickMatchGroup (MatchGroup matches ty) = do
let isOneOfMany = True -- AJG: for now
let isOneOfMany = matchesOneOfMany matches
matches' <- mapM (liftL (addTickMatch isOneOfMany)) matches
return $ MatchGroup matches' ty
......@@ -513,6 +513,14 @@ hpcLoc = L hpcSrcSpan
\end{code}
\begin{code}
matchesOneOfMany :: [LMatch Id] -> Bool
matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
where
matchCount (L _ (Match _pats _ty (GRHSs grhss _binds))) = length grhss
\end{code}
\begin{code}
---------------------------------------------------------------
-- Datatypes and file-access routines for the per-module (.mix)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment