diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-08-05 14:24:54 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-08-05 16:50:41 +0100 |
| commit | 953648127cea2836ec134b03a966695ac0b36434 (patch) | |
| tree | 6b5721dc6f0133b54af97c60f396e9207ef223ae /compiler/typecheck/TcClassDcl.hs | |
| parent | ab98860871cfac17417d5b55e590445064d21111 (diff) | |
| download | haskell-953648127cea2836ec134b03a966695ac0b36434.tar.gz | |
Tidy up and refactor wildcard handling
When examining #10615, I found the wildcard handling hard
to understand. This patch refactors quite a bit, but with
no real change in behaviour.
* Split out TcIdSigInfo from TcSigInfo, as a separate type,
like TcPatSynInfo.
* Make TcIdSigInfo express more invariants by pushing the
wildard info into TcIdSigBndr
* Remove all special treatment of unification variables that arise
from wildcards; so the TauTv of TcType.MetaInfo loses its Bool
argument.
A ton of konck on changes. The result is significantly simpler, I think.
Diffstat (limited to 'compiler/typecheck/TcClassDcl.hs')
| -rw-r--r-- | compiler/typecheck/TcClassDcl.hs | 17 |
1 files changed, 9 insertions, 8 deletions
diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs index e868da2638..bb4159a4be 100644 --- a/compiler/typecheck/TcClassDcl.hs +++ b/compiler/typecheck/TcClassDcl.hs @@ -9,7 +9,7 @@ Typechecking class declarations {-# LANGUAGE CPP #-} module TcClassDcl ( tcClassSigs, tcClassDecl2, - findMethodBind, instantiateMethod, + findMethodBind, instantiateMethod, tcClassMinimalDef, HsSigFun, mkHsSigFun, lookupHsSig, emptyHsSigs, tcMkDeclCtxt, tcAddDeclCtxt, badMethodErr @@ -19,7 +19,7 @@ module TcClassDcl ( tcClassSigs, tcClassDecl2, import HsSyn import TcEnv -import TcPat( addInlinePrags, completeSigPolyId, lookupPragEnv, emptyPragEnv ) +import TcPat( addInlinePrags, completeIdSigPolyId, lookupPragEnv, emptyPragEnv ) import TcEvidence( idHsWrapper ) import TcBinds import TcUnify @@ -207,8 +207,8 @@ tcDefMeth clas tyvars this_dict binds_in (ptext (sLit "Ignoring SPECIALISE pragmas on default method") <+> quotes (ppr sel_name)) - ; let hs_ty = lookupHsSig hs_sig_fn sel_name - `orElse` pprPanic "tc_dm" (ppr sel_name) + ; let hs_ty = lookupHsSig hs_sig_fn sel_name + `orElse` pprPanic "tc_dm" (ppr sel_name) -- We need the HsType so that we can bring the right -- type variables into scope -- @@ -225,18 +225,19 @@ tcDefMeth clas tyvars this_dict binds_in -- Substitute the local_meth_name for the binder -- NB: the binding is always a FunBind - ; local_dm_sig <- instTcTySig hs_ty local_dm_ty Nothing [] local_dm_name - ; let local_dm_sig' = local_dm_sig { sig_warn_redundant = warn_redundant } + ctxt = FunSigCtxt sel_name warn_redundant + + ; local_dm_sig <- instTcTySig ctxt hs_ty local_dm_ty Nothing [] local_dm_name ; (ev_binds, (tc_bind, _)) <- checkConstraints (ClsSkol clas) tyvars [this_dict] $ - tcPolyCheck NonRecursive no_prag_fn local_dm_sig' + tcPolyCheck NonRecursive no_prag_fn local_dm_sig (L bind_loc lm_bind) ; let export = ABE { abe_poly = global_dm_id -- We have created a complete type signature in -- instTcTySig, hence it is safe to call -- completeSigPolyId - , abe_mono = completeSigPolyId local_dm_sig' + , abe_mono = completeIdSigPolyId local_dm_sig , abe_wrap = idHsWrapper , abe_prags = IsDefaultMethod } full_bind = AbsBinds { abs_tvs = tyvars |