diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2013-02-27 09:57:09 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2013-02-27 09:57:09 +0000 |
| commit | 47d226544fc3fb11d024740a162f8ae4e1d044c9 (patch) | |
| tree | 8a024b97de71216f6b3606d3cda7bf16ae1f98a6 /compiler/deSugar/Coverage.lhs | |
| parent | 7b5e514d85c086be8dc6d938b526c97b6ced56eb (diff) | |
| parent | 0ee31659afe7a6819f9eb5e233f98e5592f1b439 (diff) | |
| download | haskell-tc-arrows.tar.gz | |
Merge remote-tracking branch 'origin/master' into tc-arrowstc-arrows
Diffstat (limited to 'compiler/deSugar/Coverage.lhs')
| -rw-r--r-- | compiler/deSugar/Coverage.lhs | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 5cd85139e2..bdcf9c9f78 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -519,10 +519,14 @@ addTickHsExpr (HsDo cxt stmts srcloc) forQual = case cxt of ListComp -> Just $ BinBox QualBinBox _ -> Nothing -addTickHsExpr (ExplicitList ty es) = - liftM2 ExplicitList +addTickHsExpr (ExplicitList ty wit es) = + liftM3 ExplicitList (return ty) - (mapM (addTickLHsExpr) es) + (addTickWit wit) + (mapM (addTickLHsExpr) es) + where addTickWit Nothing = return Nothing + addTickWit (Just fln) = do fln' <- addTickHsExpr fln + return (Just fln') addTickHsExpr (ExplicitPArr ty es) = liftM2 ExplicitPArr (return ty) @@ -543,10 +547,14 @@ addTickHsExpr (ExprWithTySigOut e ty) = (addTickLHsExprNever e) -- No need to tick the inner expression -- for expressions with signatures (return ty) -addTickHsExpr (ArithSeq ty arith_seq) = - liftM2 ArithSeq +addTickHsExpr (ArithSeq ty wit arith_seq) = + liftM3 ArithSeq (return ty) + (addTickWit wit) (addTickArithSeqInfo arith_seq) + where addTickWit Nothing = return Nothing + addTickWit (Just fl) = do fl' <- addTickHsExpr fl + return (Just fl') addTickHsExpr (HsTickPragma _ (L pos e0)) = do e2 <- allocTickBox (ExpBox False) False False pos $ addTickHsExpr e0 |