X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsExpr.lhs;h=5eff4732c2fed47c13f9dd161d2589cbe849c63e;hb=52bd2cc7a9f328e6a7f3f50ac0055a5361f457c1;hp=d34d4b9a456b1638850de8cd78f006764501c426;hpb=16e4ce4c0c02650082f2e11982017c903c549ad5;p=ghc-hetmet.git

diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index d34d4b9..5eff473 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -195,7 +195,7 @@ data HsExpr id
 			-- False => left-to-right (arg >- f)
 	SrcLoc
 
-  | HsArrForm	-- Command formation,  (| e |) cmd1 .. cmdn
+  | HsArrForm	-- Command formation,  (| e cmd1 .. cmdn |)
 	(HsExpr id)	-- the operator
 			-- after type-checking, a type abstraction to be
 			-- applied to the type of the local environment tuple
@@ -286,7 +286,7 @@ ppr_expr (HsLam match) = pprMatch LambdaExpr match
 
 ppr_expr expr@(HsApp e1 e2)
   = let (fun, args) = collect_args expr [] in
-    (ppr_expr fun) <+> (sep (map ppr_expr args))
+    (ppr_expr fun) <+> (sep (map pprParendExpr args))
   where
     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
     collect_args fun		 args = (fun, args)
@@ -447,8 +447,8 @@ ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False _)
 ppr_expr (HsArrForm (HsVar v) (Just _) [arg1, arg2] _)
   = sep [pprCmdArg arg1, hsep [pprInfix v, pprCmdArg arg2]]
 ppr_expr (HsArrForm op _ args _)
-  = hang (ptext SLIT("(|") <> pprExpr op <> ptext SLIT("|)"))
-	 4 (sep (map pprCmdArg args))
+  = hang (ptext SLIT("(|") <> pprExpr op)
+	 4 (sep (map pprCmdArg args) <> ptext SLIT("|)"))
 
 pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
 pprCmdArg (HsCmdTop cmd@(HsArrForm _ Nothing [] _) _ _ _) = pprExpr cmd
@@ -509,6 +509,9 @@ The legal constructors for commands are:
 
   | HsArrForm ...		-- as above
 
+  | HsApp	(HsCmd id)
+		(HsExpr id)
+
   | HsLam	(Match  id)	-- kappa
 
   -- the renamer turns this one into HsArrForm