Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
402c1716
Commit
402c1716
authored
Feb 10, 1999
by
simonpj
Browse files
[project @ 1999-02-10 16:01:17 by simonpj]
Tiny error-message hacks
parent
cedd20d4
Changes
6
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/hsSyn/HsSyn.lhs
View file @
402c1716
...
...
@@ -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
View file @
402c1716
...
...
@@ -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
View file @
402c1716
...
...
@@ -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
View file @
402c1716
...
...
@@ -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
View file @
402c1716
...
...
@@ -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
View file @
402c1716
...
...
@@ -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 ()
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment