From 6f531423b6927191dac4958ed11086def74cb3b3 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 3 Apr 2000 16:46:42 +0000
Subject: [PATCH] [project @ 2000-04-03 16:46:41 by simonpj] * Minor wibble to
type checker error message
* Make error messages come out to stderr (I'd switched
to stdout temporarily when fighting the Dreaded Stderr Bug
and forgot to change back)
---
ghc/compiler/typecheck/TcBinds.lhs | 2 +-
ghc/compiler/typecheck/TcMonoType.lhs | 6 ++----
ghc/compiler/utils/Outputable.lhs | 2 +-
3 files changed, 4 insertions(+), 6 deletions(-)
diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index a7a589c7125f..1a360513e8e1 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -796,7 +796,7 @@ checkSigMatch top_lvl binder_names mono_ids sigs
mk_dict_tys theta = map mkPredTy theta
- sig_msg id = ptext SLIT("When checking the type signature for") <+> ppr id
+ sig_msg id = ptext SLIT("When checking the type signature for") <+> quotes (ppr id)
-- Search for Main.main in the binder_names, return corresponding mono_id
find_main NotTopLevel binder_names mono_ids = Nothing
diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs
index 0943cfb792e9..2745f78a6c19 100644
--- a/ghc/compiler/typecheck/TcMonoType.lhs
+++ b/ghc/compiler/typecheck/TcMonoType.lhs
@@ -38,7 +38,7 @@ import Type ( Type, PredType(..), ThetaType, UsageAnn(..),
boxedTypeKind, unboxedTypeKind, tyVarsOfType,
mkArrowKinds, getTyVar_maybe, getTyVar,
tidyOpenType, tidyOpenTypes, tidyTyVar, tidyTyVars,
- tyVarsOfType, tyVarsOfTypes
+ tyVarsOfType, tyVarsOfTypes, mkForAllTys
)
import PprType ( pprConstraint, pprType )
import Subst ( mkTopTyVarSubst, substTy )
@@ -688,9 +688,7 @@ sigCtxt when sig_tyvars sig_theta sig_tau tidy_env
(env1, tidy_sig_tyvars) = tidyTyVars tidy_env sig_tyvars
(env2, tidy_sig_rho) = tidyOpenType env1 (mkRhoTy sig_theta sig_tau)
(env3, tidy_actual_tau) = tidyOpenType env1 actual_tau
- forall | null sig_tyvars = empty
- | otherwise = ptext SLIT("forall") <+> hsep (map ppr tidy_sig_tyvars) <> dot
- msg = vcat [ptext SLIT("Signature type: ") <+> forall <+> pprType tidy_sig_rho,
+ msg = vcat [ptext SLIT("Signature type: ") <+> pprType (mkForAllTys tidy_sig_tyvars tidy_sig_rho),
ptext SLIT("Type to generalise:") <+> pprType tidy_actual_tau,
when
]
diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 1f23e5e853ed..19ad6666776d 100644
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -155,7 +155,7 @@ printSDoc d sty = printDoc PageMode stdout (d sty)
-- I'm not sure whether the direct-IO approach of printDoc
-- above is better or worse than the put-big-string approach here
printErrs :: SDoc -> IO ()
-printErrs doc = printDoc PageMode stdout (final_doc user_style)
+printErrs doc = printDoc PageMode stderr (final_doc user_style)
where
final_doc = doc -- $$ text ""
user_style = mkUserStyle (PartWay opt_PprUserLength)
--
GitLab