From 5af7fb4ffe4672dbc9cf34100ea311eb60981fe8 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 19 Apr 2011 13:33:09 +0100 Subject: [PATCH] Fix Trac #5045: add ticks to HsArrForms I don't know why these were left out. I did the obvious thing... I hope it's right! --- compiler/deSugar/Coverage.lhs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index b28f3eb..0daa6be 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -365,6 +365,20 @@ addTickHsExpr (HsWrap w e) = (return w) (addTickHsExpr e) -- explicitly no tick on inside +addTickHsExpr (HsArrApp e1 e2 ty1 arr_ty lr) = + liftM5 HsArrApp + (addTickLHsExpr e1) + (addTickLHsExpr e2) + (return ty1) + (return arr_ty) + (return lr) + +addTickHsExpr (HsArrForm e fix cmdtop) = + liftM3 HsArrForm + (addTickLHsExpr e) + (return fix) + (mapM (liftL (addTickHsCmdTop)) cmdtop) + addTickHsExpr e@(HsType _) = return e -- Others dhould never happen in expression content. @@ -558,7 +572,7 @@ addTickHsCmd (HsLet binds c) = addTickHsCmd (HsDo cxt stmts last_exp srcloc) = do (stmts', last_exp') <- addTickLCmdStmts' stmts (addTickLHsCmd last_exp) return (HsDo cxt stmts' last_exp' srcloc) - where + addTickHsCmd (HsArrApp e1 e2 ty1 arr_ty lr) = liftM5 HsArrApp (addTickLHsExpr e1) -- 1.7.10.4