Commit 402c1716 authored by simonpj's avatar simonpj
Browse files

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

Tiny error-message hacks
parent cedd20d4
......@@ -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,
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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')
......
......@@ -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 ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment