summaryrefslogtreecommitdiff
path: root/compiler/typecheck/TcTyClsDecls.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2015-12-01 17:38:23 +0100
committerBen Gamari <ben@smart-cactus.org>2015-12-01 18:45:23 +0100
commit1e041b7382b6aa329e4ad9625439f811e0f27232 (patch)
tree91f4418553a1e6df072f56f43b5697d40c985b5f /compiler/typecheck/TcTyClsDecls.hs
parentb432e2f39c095d8acbb0cfcc63bd08436c7a3e49 (diff)
downloadhaskell-1e041b7382b6aa329e4ad9625439f811e0f27232.tar.gz
Refactor treatment of wildcards
This patch began as a modest refactoring of HsType and friends, to clarify and tidy up exactly where quantification takes place in types. Although initially driven by making the implementation of wildcards more tidy (and fixing a number of bugs), I gradually got drawn into a pretty big process, which I've been doing on and off for quite a long time. There is one compiler performance regression as a result of all this, in perf/compiler/T3064. I still need to look into that. * The principal driving change is described in Note [HsType binders] in HsType. Well worth reading! * Those data type changes drive almost everything else. In particular we now statically know where (a) implicit quantification only (LHsSigType), e.g. in instance declaratios and SPECIALISE signatures (b) implicit quantification and wildcards (LHsSigWcType) can appear, e.g. in function type signatures * As part of this change, HsForAllTy is (a) simplified (no wildcards) and (b) split into HsForAllTy and HsQualTy. The two contructors appear when and only when the correponding user-level construct appears. Again see Note [HsType binders]. HsExplicitFlag disappears altogether. * Other simplifications - ExprWithTySig no longer needs an ExprWithTySigOut variant - TypeSig no longer needs a PostRn name [name] field for wildcards - PatSynSig records a LHsSigType rather than the decomposed pieces - The mysterious 'GenericSig' is now 'ClassOpSig' * Renamed LHsTyVarBndrs to LHsQTyVars * There are some uninteresting knock-on changes in Haddock, because of the HsSyn changes I also did a bunch of loosely-related changes: * We already had type synonyms CoercionN/CoercionR for nominal and representational coercions. I've added similar treatment for TcCoercionN/TcCoercionR mkWpCastN/mkWpCastN All just type synonyms but jolly useful. * I record-ised ForeignImport and ForeignExport * I improved the (poor) fix to Trac #10896, by making TcTyClsDecls.checkValidTyCl recover from errors, but adding a harmless, abstract TyCon to the envt if so. * I did some significant refactoring in RnEnv.lookupSubBndrOcc, for reasons that I have (embarrassingly) now totally forgotten. It had to do with something to do with import and export Updates haddock submodule.
Diffstat (limited to 'compiler/typecheck/TcTyClsDecls.hs')
-rw-r--r--compiler/typecheck/TcTyClsDecls.hs45
1 files changed, 26 insertions, 19 deletions
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 8e42ff261f..a2b6a6386e 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -32,6 +32,7 @@ import TcTyDecls
import TcClassDcl
import TcHsType
import TcMType
+import RnTypes( collectAnonWildCards )
import TcType
import FamInst
import FamInstEnv
@@ -171,10 +172,11 @@ tcTyClGroup tyclds
zipRecTyClss :: [(Name, Kind)]
-> [TyCon] -- Knot-tied
-> [(Name,TyThing)]
--- Build a name-TyThing mapping for the things bound by decls
--- being careful not to look at the [TyThing]
+-- Build a name-TyThing mapping for the TyCons bound by decls
+-- being careful not to look at the knot-tied [TyThing]
-- The TyThings in the result list must have a visible ATyCon,
--- because typechecking types (in, say, tcTyClDecl) looks at this outer constructor
+-- because typechecking types (in, say, tcTyClDecl) looks at
+-- this outer constructor
zipRecTyClss kind_pairs rec_tycons
= [ (name, ATyCon (get name)) | (name, _kind) <- kind_pairs ]
where
@@ -478,9 +480,8 @@ kcTyClDecl (ClassDecl { tcdLName = L _ name, tcdTyVars = hs_tvs
do { _ <- tcHsContext ctxt
; mapM_ (wrapLocM kc_sig) sigs }
where
- kc_sig (TypeSig _ op_ty _) = discardResult (tcHsLiftedType op_ty)
- kc_sig (GenericSig _ op_ty) = discardResult (tcHsLiftedType op_ty)
- kc_sig _ = return ()
+ kc_sig (ClassOpSig _ nms op_ty) = kcClassSigType nms op_ty
+ kc_sig _ = return ()
-- closed type families look at their equations, but other families don't
-- do anything here
@@ -1046,9 +1047,9 @@ famTyConShape fam_tc
tc_fam_ty_pats :: FamTyConShape
-> Maybe ClsInfo
- -> HsWithBndrs Name [LHsType Name] -- Patterns
- -> (TcKind -> TcM ()) -- Kind checker for RHS
- -- result is ignored
+ -> HsTyPats Name -- Patterns
+ -> (TcKind -> TcM ()) -- Kind checker for RHS
+ -- result is ignored
-> TcM ([Kind], [Type], Kind)
-- Check the type patterns of a type or data family instance
-- type instance F <pat1> <pat2> = <type>
@@ -1062,8 +1063,8 @@ tc_fam_ty_pats :: FamTyConShape
-- (and, if C is poly-kinded, so will its kind parameter).
tc_fam_ty_pats (name, arity, kind) mb_clsinfo
- (HsWB { hswb_cts = arg_pats, hswb_kvs = kvars
- , hswb_tvs = tvars, hswb_wcs = wcs })
+ (HsIB { hsib_body = arg_pats, hsib_kvs = kvars
+ , hsib_tvs = tvars })
kind_checker
= do { let (fam_kvs, fam_body) = splitForAllTys kind
@@ -1089,14 +1090,16 @@ tc_fam_ty_pats (name, arity, kind) mb_clsinfo
substKiWith fam_kvs fam_arg_kinds fam_body
-- Treat (anonymous) wild cards as type variables without a name.
-- See Note [Wild cards in family instances]
- anon_tvs = [L (nameSrcSpan wc)
- (UserTyVar (L (nameSrcSpan wc) wc)) | wc <- wcs]
+ wcs = concatMap collectAnonWildCards arg_pats
+ anon_tvs = [L loc (UserTyVar (L loc wc))
+ | wc <- wcs
+ , let loc = nameSrcSpan wc ]
hs_tvs = HsQTvs { hsq_kvs = kvars
, hsq_tvs = anon_tvs ++ userHsTyVarBndrs loc tvars }
-- Kind-check and quantify
-- See Note [Quantifying over family patterns]
- ; typats <- tcHsTyVarBndrs hs_tvs $ \ _ ->
+ ; typats <- tcHsQTyVars hs_tvs $ \ _ ->
do { kind_checker res_kind
; tcHsArgTys (quotes (ppr name)) arg_pats arg_kinds }
@@ -1105,8 +1108,8 @@ tc_fam_ty_pats (name, arity, kind) mb_clsinfo
-- See Note [tc_fam_ty_pats vs tcFamTyPats]
tcFamTyPats :: FamTyConShape
-> Maybe ClsInfo
- -> HsWithBndrs Name [LHsType Name] -- patterns
- -> (TcKind -> TcM ()) -- kind-checker for RHS
+ -> HsTyPats Name -- patterns
+ -> (TcKind -> TcM ()) -- kind-checker for RHS
-> ([TKVar] -- Kind and type variables
-> [TcType] -- Kind and type arguments
-> Kind -> TcM a)
@@ -1264,9 +1267,10 @@ tcConDecl new_or_data is_prom rep_tycon tmpl_tvs res_tmpl
= addErrCtxt (dataConCtxtName names) $
do { traceTc "tcConDecl 1" (ppr names)
; (ctxt, arg_tys, res_ty, field_lbls, stricts)
- <- tcHsTyVarBndrs hs_tvs $ \ _ ->
- do { ctxt <- tcHsContext hs_ctxt
- ; btys <- tcConArgs new_or_data hs_details
+ <- tcHsQTyVars hs_tvs $ \ _ ->
+ do { traceTc "tcConDecl" (ppr names <+> text "tvs:" <+> ppr hs_tvs)
+ ; ctxt <- tcHsContext hs_ctxt
+ ; btys <- tcConArgs new_or_data hs_details
; res_ty <- tcConRes hs_res_ty
; field_lbls <- lookupConstructorFields (unLoc $ head names)
; let (arg_tys, stricts) = unzip btys
@@ -1299,6 +1303,9 @@ tcConDecl new_or_data is_prom rep_tycon tmpl_tvs res_tmpl
-- See Note [Checking GADT return types]
; fam_envs <- tcGetFamInstEnvs
+
+ -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here
+ ; traceTc "tcConDecl 2" (ppr names $$ ppr field_lbls)
; let
buildOneDataCon (L _ name) = do
{ is_infix <- tcConIsInfix name hs_details res_ty