X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FCoverage.lhs;h=2136d016750a708321c146409ae3fbe76d3f62b1;hp=dce7962fcf99295aedf5f68144823d2054b64cc3;hb=f04dead93a15af1cb818172f207b8a81d2c81298;hpb=69f8ed93800605d8df011388450d6d3bb9ca6071 diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index dce7962..2136d01 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -461,13 +461,15 @@ addTickStmt isGuard (GroupStmt (stmts, binderMap) groupByClause) = do case x of Left a -> f a >>= (return . Left) Right b -> g b >>= (return . Right) -addTickStmt isGuard (RecStmt stmts ids1 ids2 tys dictbinds) = do - liftM5 RecStmt - (addTickLStmts isGuard stmts) - (return ids1) - (return ids2) - (return tys) - (addTickDictBinds dictbinds) +addTickStmt isGuard stmt@(RecStmt {}) + = do { stmts' <- addTickLStmts isGuard (recS_stmts stmt) + ; ret' <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt) + ; mfix' <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt) + ; bind' <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt) + ; dicts' <- addTickDictBinds (recS_dicts stmt) + ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret' + , recS_mfix_fn = mfix', recS_bind_fn = bind' + , recS_dicts = dicts' }) } addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id) addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e