From 402c1716fed6f9888f05a7431eb9ceeeb1e4bc91 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
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 fb656a200268..623184c255c8 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 96c7b671303b..c5abb68aff12 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 03752ef27596..8cde74fea5e3 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 d9643ad33899..b990ab716d69 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 4be592ae35b4..1fd4d9545f99 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 dfefd854b36e..bd33b865d867 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 ()
--
GitLab