From 402c1716fed6f9888f05a7431eb9ceeeb1e4bc91 Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 10 Feb 1999 16:01:22 +0000 Subject: [PATCH] [project @ 1999-02-10 16:01:17 by simonpj] Tiny error-message hacks --- ghc/compiler/hsSyn/HsSyn.lhs | 2 +- ghc/compiler/main/ErrUtils.lhs | 2 +- ghc/compiler/rename/RnBinds.lhs | 2 +- ghc/compiler/rename/RnExpr.lhs | 4 ++-- ghc/compiler/rename/RnSource.lhs | 10 +++++----- ghc/compiler/utils/Outputable.lhs | 2 +- 6 files changed, 11 insertions(+), 11 deletions(-) diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index fb656a2..623184c 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -76,7 +76,7 @@ instance (Outputable name, Outputable pat) Nothing -> hsep [ptext SLIT("module"), pprModule name, ptext SLIT("where")] Just es -> vcat [ hsep [ptext SLIT("module"), pprModule name, lparen], - nest 8 (interpp'SP es), + nest 8 (fsep (punctuate comma (map ppr es))), nest 4 (ptext SLIT(") where")) ], pp_nonnull imports, diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs index 96c7b67..c5abb68 100644 --- a/ghc/compiler/main/ErrUtils.lhs +++ b/ghc/compiler/main/ErrUtils.lhs @@ -59,7 +59,7 @@ dontAddErrLoc title rest_of_err_msg pprBagOfErrors :: Bag ErrMsg -> SDoc pprBagOfErrors bag_of_errors - = text "" $$ vcat [p $$ text "" | (_,p) <- sorted_errs ] + = vcat [text "" $$ p | (_,p) <- sorted_errs ] where bag_ls = bagToList bag_of_errors sorted_errs = sortLt occ'ed_before bag_ls diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs index 03752ef..8cde74f 100644 --- a/ghc/compiler/rename/RnBinds.lhs +++ b/ghc/compiler/rename/RnBinds.lhs @@ -207,7 +207,7 @@ rnMonoBinds mbinds sigs thing_inside -- Non-empty monobinds = -- Extract all the binders in this group, -- and extend current scope, inventing new names for the new binders -- This also checks that the names form a set - bindLocatedLocalsRn (text "binding group") mbinders_w_srclocs $ \ new_mbinders -> + bindLocatedLocalsRn (text "a binding group") mbinders_w_srclocs $ \ new_mbinders -> let binder_set = mkNameSet new_mbinders in diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index d9643ad..b990ab7 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -172,7 +172,7 @@ rnMatch match@(Match _ pats maybe_rhs_sig grhss) -- Note that we do a single bindLocalsRn for all the -- matches together, so that we spot the repeated variable in -- f x x = 1 - bindLocalsFVRn "pattern" (collectPatsBinders pats) $ \ new_binders -> + bindLocalsFVRn "a pattern" (collectPatsBinders pats) $ \ new_binders -> mapAndUnzipRn rnPat pats `thenRn` \ (pats', pat_fvs_s) -> rnGRHSs grhss `thenRn` \ (grhss', grhss_fvs) -> @@ -484,7 +484,7 @@ rnStmt :: RnExprTy s -> RdrNameStmt rnStmt rn_expr (BindStmt pat expr src_loc) thing_inside = pushSrcLocRn src_loc $ rn_expr expr `thenRn` \ (expr', fv_expr) -> - bindLocalsFVRn "pattern in do binding" binders $ \ new_binders -> + bindLocalsFVRn "a pattern in do binding" binders $ \ new_binders -> rnPat pat `thenRn` \ (pat', fv_pat) -> thing_inside (BindStmt pat' expr' src_loc) `thenRn` \ (result, fvs) -> returnRn (result, fv_expr `plusFV` fvs `plusFV` fv_pat) diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index 4be592a..1fd4d95 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/ghc/compiler/rename/RnSource.lhs @@ -677,7 +677,7 @@ rnCoreExpr (UfApp fun arg) rnCoreExpr (UfCase scrut bndr alts) = rnCoreExpr scrut `thenRn` \ scrut' -> - bindLocalsRn "UfCase" [bndr] $ \ [bndr'] -> + bindLocalsRn "a UfCase" [bndr] $ \ [bndr'] -> mapRn rnCoreAlt alts `thenRn` \ alts' -> returnRn (UfCase scrut' bndr' alts') @@ -715,7 +715,7 @@ rnCoreBndr (UfValBinder name ty) thing_inside str = "unfolding id" rnCoreBndr (UfTyBinder name kind) thing_inside - = bindLocalsRn "unfolding tyvar" [name] $ \ [name'] -> + = bindLocalsRn "an unfolding tyvar" [name] $ \ [name'] -> thing_inside (UfTyBinder name' kind) rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders @@ -730,9 +730,9 @@ rnCoreBndrs bndrs thing_inside -- Expect them all to be ValBinders \begin{code} rnCoreAlt (con, bndrs, rhs) - = rnUfCon con `thenRn` \ con' -> - bindLocalsRn "unfolding alt" bndrs $ \ bndrs' -> - rnCoreExpr rhs `thenRn` \ rhs' -> + = rnUfCon con `thenRn` \ con' -> + bindLocalsRn "an unfolding alt" bndrs $ \ bndrs' -> + rnCoreExpr rhs `thenRn` \ rhs' -> returnRn (con', bndrs', rhs') diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs index dfefd85..bd33b86 100644 --- a/ghc/compiler/utils/Outputable.lhs +++ b/ghc/compiler/utils/Outputable.lhs @@ -156,7 +156,7 @@ printSDoc d sty = printDoc PageMode stdout (d sty) printErrs :: SDoc -> IO () printErrs doc = printDoc PageMode stderr (final_doc user_style) where - final_doc = doc $$ text "" + final_doc = doc -- $$ text "" user_style = mkUserStyle (PartWay opt_PprUserLength) printDump :: SDoc -> IO () -- 1.7.10.4