projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1998-06-08 11:45:09 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
typecheck
/
TcBinds.lhs
diff --git
a/ghc/compiler/typecheck/TcBinds.lhs
b/ghc/compiler/typecheck/TcBinds.lhs
index
b5765ef
..
cb56629
100644
(file)
--- a/
ghc/compiler/typecheck/TcBinds.lhs
+++ b/
ghc/compiler/typecheck/TcBinds.lhs
@@
-268,11
+268,11
@@
tcBindWithSigs top_lvl binder_names mbind tc_ty_sigs is_rec prag_info_fn
-- The tyvars_not_to_gen are free in the environment, and hence
-- candidates for generalisation, but sometimes the monomorphism
-- restriction means we can't generalise them nevertheless
-- The tyvars_not_to_gen are free in the environment, and hence
-- candidates for generalisation, but sometimes the monomorphism
-- restriction means we can't generalise them nevertheless
- getTyVarsToGen is_unrestricted mono_id_tys lie `thenTc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
+ getTyVarsToGen is_unrestricted mono_id_tys lie `thenNF_Tc` \ (tyvars_not_to_gen, tyvars_to_gen) ->
-- DEAL WITH TYPE VARIABLE KINDS
-- **** This step can do unification => keep other zonking after this ****
-- DEAL WITH TYPE VARIABLE KINDS
-- **** This step can do unification => keep other zonking after this ****
- mapTc defaultUncommittedTyVar (tyVarSetToList tyvars_to_gen) `thenTc` \ real_tyvars_to_gen_list ->
+ mapTc defaultUncommittedTyVar (tyVarSetToList tyvars_to_gen) `thenTc` \ real_tyvars_to_gen_list ->
let
real_tyvars_to_gen = mkTyVarSet real_tyvars_to_gen_list
-- It's important that the final list
let
real_tyvars_to_gen = mkTyVarSet real_tyvars_to_gen_list
-- It's important that the final list
@@
-487,8
+487,13
@@
getTyVarsToGen is_unrestricted mono_id_tys lie
in
if is_unrestricted
then
in
if is_unrestricted
then
- returnTc (emptyTyVarSet, tyvars_to_gen)
+ returnNF_Tc (emptyTyVarSet, tyvars_to_gen)
else
else
+ -- This recover and discard-errs is to avoid duplicate error
+ -- messages; this, after all, is an "extra" call to tcSimplify
+ recoverNF_Tc (returnNF_Tc (emptyTyVarSet, tyvars_to_gen)) $
+ discardErrsTc $
+
tcSimplify (text "getTVG") NotTopLevel tyvars_to_gen lie `thenTc` \ (_, _, constrained_dicts) ->
let
-- ASSERT: dicts_sig is already zonked!
tcSimplify (text "getTVG") NotTopLevel tyvars_to_gen lie `thenTc` \ (_, _, constrained_dicts) ->
let
-- ASSERT: dicts_sig is already zonked!