X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsExpr.lhs;h=bbb271204237627537b49ca55e0c76717fcfc46d;hb=e63e94a280a727854ef1a3e03f14afedf9f94fc9;hp=d21315817045889a87ddeb3e0005aa9a461dca44;hpb=1aaf9dc3eee4942855cfa3416ae8a518cd65a95a;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs
index d213158..bbb2712 100644
--- a/compiler/hsSyn/HsExpr.lhs
+++ b/compiler/hsSyn/HsExpr.lhs
@@ -15,7 +15,6 @@ import HsDecls
 import HsPat
 import HsLit
 import HsTypes
-import HsImpExp
 import HsBinds
 
 -- others:
@@ -160,7 +159,7 @@ data HsExpr id
   | RecordUpd   (LHsExpr id)
                 (HsRecordBinds id)
                 [DataCon]          -- Filled in by the type checker to the
-                                   -- *non-empty* list of DataCons that have
+                                   -- _non-empty_ list of DataCons that have
                                    -- all the upd'd fields
                 [PostTcType]       -- Argument types of *input* record type
                 [PostTcType]       --              and  *output* record type
@@ -198,7 +197,7 @@ data HsExpr id
   | HsBracketOut (HsBracket Name)       -- Output of the type checker is
                                         -- the *original*
                  [PendingSplice]        -- renamed expression, plus
-                                        -- *typechecked* splices to be
+                                        -- _typechecked_ splices to be
                                         -- pasted back in by the desugarer
 
   | HsSpliceE (HsSplice id)
@@ -346,7 +345,7 @@ ppr_expr (OpApp e1 op _ e2)
       = hang (ppr op) 2 (sep [pp_e1, pp_e2])
 
     pp_infixly v
-      = sep [nest 2 pp_e1, pprInfix v, nest 2 pp_e2]
+      = sep [nest 2 pp_e1, pprHsInfix v, nest 2 pp_e2]
 
 ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
 
@@ -359,7 +358,7 @@ ppr_expr (SectionL expr op)
 
     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
                        4 (hsep [pp_expr, ptext (sLit "x_ )")])
-    pp_infixly v = (sep [pp_expr, pprInfix v])
+    pp_infixly v = (sep [pp_expr, pprHsInfix v])
 
 ppr_expr (SectionR op expr)
   = case unLoc op of
@@ -371,7 +370,7 @@ ppr_expr (SectionR op expr)
     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
                        4 ((<>) pp_expr rparen)
     pp_infixly v
-      = (sep [pprInfix v, pp_expr])
+      = (sep [pprHsInfix v, pp_expr])
 
 --avoid using PatternSignatures for stage1 code portability
 ppr_expr exprType@(HsLam matches)
@@ -379,8 +378,8 @@ ppr_expr exprType@(HsLam matches)
  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
 
 ppr_expr exprType@(HsCase expr matches)
-  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of")],
-          nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches) ]
+  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
+          nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches <+> char '}') ]
  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
 
 ppr_expr (HsIf e1 e2 e3)
@@ -477,7 +476,7 @@ ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
   = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
 
 ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
-  = sep [pprCmdArg (unLoc arg1), hsep [pprInfix v, pprCmdArg (unLoc arg2)]]
+  = sep [pprCmdArg (unLoc arg1), hsep [pprHsInfix v, pprCmdArg (unLoc arg2)]]
 ppr_expr (HsArrForm op _ args)
   = hang (ptext (sLit "(|") <> ppr_lexpr op)
          4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
@@ -491,12 +490,6 @@ pprCmdArg (HsCmdTop cmd _ _ _)
 instance OutputableBndr id => Outputable (HsCmdTop id) where
     ppr = pprCmdArg
 
--- Put a var in backquotes if it's not an operator already
-pprInfix :: Outputable name => name -> SDoc
-pprInfix v | isOperator ppr_v = ppr_v
-           | otherwise        = char '`' <> ppr_v <> char '`'
-    where ppr_v = ppr v
-
 -- add parallel array brackets around a document
 --
 pa_brackets :: SDoc -> SDoc
@@ -670,9 +663,12 @@ data Match id
                                 -- Nothing after typechecking
         (GRHSs id)
 
+isEmptyMatchGroup :: MatchGroup id -> Bool
+isEmptyMatchGroup (MatchGroup ms _) = null ms
+
 matchGroupArity :: MatchGroup id -> Arity
 matchGroupArity (MatchGroup [] _)
-  = panic "matchGroupArity"     -- MatchGroup is never empty
+  = panic "matchGroupArity"     -- Precondition: MatchGroup is non-empty
 matchGroupArity (MatchGroup (match:matches) _)
   = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
     -- Assertion just checks that all the matches have the same number of pats