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

Tiny error-message hacks

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,

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

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

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)

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')
 
 

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 ()