[commit: ghc] master: Fix #5045 properly (10801b5)

[Ross Paterson]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/10801b5568a8777dca5e42cca0b9cf5520d36763

>---------------------------------------------------------------

commit 10801b5568a8777dca5e42cca0b9cf5520d36763
Author: Ross Paterson <ross at soi.city.ac.uk>
Date:   Wed Jun 29 18:50:48 2011 +0100

    Fix #5045 properly
    
    In arrow commands, the function position in an application (HsApp)
    is a command, not an expression.

>---------------------------------------------------------------

 compiler/deSugar/Coverage.lhs |   18 ++----------------
 1 files changed, 2 insertions(+), 16 deletions(-)

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 13f1796..6f2e08a 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -364,20 +364,6 @@ 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.
@@ -544,8 +530,8 @@ addTickLHsCmd (L pos c0) = do
 addTickHsCmd :: HsCmd Id -> TM (HsCmd Id)
 addTickHsCmd (HsLam matchgroup) =
         liftM HsLam (addTickCmdMatchGroup matchgroup)
-addTickHsCmd (HsApp e1 e2) = 
-	liftM2 HsApp (addTickLHsExprNever e1) (addTickLHsExpr e2)
+addTickHsCmd (HsApp c e) = 
+	liftM2 HsApp (addTickLHsCmd c) (addTickLHsExpr e)
 addTickHsCmd (OpApp e1 c2 fix c3) = 
 	liftM4 OpApp 
 		(addTickLHsExpr e1)