From 13f959e89c4a23cb2337fb3157f3d7a679debf99 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Mon, 9 May 2011 16:44:30 +0100 Subject: [PATCH] Fix the desugaring of guards in arrow syntax This was making T3822 fail, which it has apparently been doing for some time (ie in GHC 7, 6.12, 6.10)! --- compiler/deSugar/Coverage.lhs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 8071da7..37cbc2d 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -608,9 +608,12 @@ addTickCmdGRHSs (GRHSs guarded local_binds) = do binders = collectLocalBinders local_binds addTickCmdGRHS :: GRHS Id -> TM (GRHS Id) -addTickCmdGRHS (GRHS stmts cmd) = do - (stmts',expr') <- addTickLCmdStmts' stmts (addTickLHsCmd cmd) - return $ GRHS stmts' expr' +-- The *guards* are *not* Cmds, although the body is +-- C.f. addTickGRHS for the BinBox stuff +addTickCmdGRHS (GRHS stmts cmd) + = do { (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) + stmts (addTickLHsCmd cmd) + ; return $ GRHS stmts' expr' } addTickLCmdStmts :: [LStmt Id] -> TM [LStmt Id] addTickLCmdStmts stmts = do -- 1.7.10.4