[project @ 1999-02-10 16:01:17 by simonpj]

Tiny error-message hacks

diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs
index fb656a2..623184c 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 ()