-----------------------------
Put existential tyvars second
[fixes ParsecPerm lint error]
-----------------------------
In an existential data constr:
data Eq a => T a = forall b. Ord b => MkT a [b]
the type of MkT is
MkT :: forall a b . Ord b => a -> [b] -> MkT a
Note that the existential tyvars (b in this case) come *after*
the "ordinary" tyvars.
I had switched this around earlier in the week, but I'm putting
it back (and fixing a bug) because I found it really works better second.
Reason: in a case expression we may find:
case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
It's convenient to apply the rep-type of MkT to 't', to get
forall b. Ord b => ...
and use that to check the pattern. Mind you, this is really only
use in CoreLint.
-- data Eq a => T a = forall b. Ord b => MkT a [b]
dcRepType :: Type, -- Type of the constructor
-- data Eq a => T a = forall b. Ord b => MkT a [b]
dcRepType :: Type, -- Type of the constructor
- -- forall b a . Ord b => a -> [b] -> MkT a
+ -- forall a b . Ord b => a -> [b] -> MkT a
-- (this is *not* of the constructor wrapper Id:
-- see notes after this data type declaration)
--
-- (this is *not* of the constructor wrapper Id:
-- see notes after this data type declaration)
--
- -- Notice that the existential type parameters come
- -- *first*. It doesn't really matter provided we are
- -- consistent.
+ -- Notice that the existential type parameters come *second*.
+ -- Reason: in a case expression we may find:
+ -- case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
+ -- It's convenient to apply the rep-type of MkT to 't', to get
+ -- forall b. Ord b => ...
+ -- and use that to check the pattern. Mind you, this is really only
+ -- use in CoreLint.
+
-- The next six fields express the type of the constructor, in pieces
-- e.g.
-- The next six fields express the type of the constructor, in pieces
-- e.g.
(rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
(rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
- ty = mkForAllTys (ex_tyvars ++ tyvars)
+ ty = mkForAllTys (tyvars ++ ex_tyvars)
(mkFunTys rep_arg_tys result_ty)
-- NB: the existential dict args are already in rep_arg_tys
(mkFunTys rep_arg_tys result_ty)
-- NB: the existential dict args are already in rep_arg_tys
dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars}) inst_tys
dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars}) inst_tys
- = map (substTyWith (ex_tyvars ++ tyvars) inst_tys) arg_tys
+ = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
dataConTheta :: DataCon -> ThetaType
dataConTheta dc = dcStupidTheta dc
dataConTheta :: DataCon -> ThetaType
dataConTheta dc = dcStupidTheta dc
dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars}) inst_tys
dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
dcExTyVars = ex_tyvars}) inst_tys
- = map (substTyWith (ex_tyvars ++ tyvars) inst_tys) arg_tys
+ = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
\end{code}
These two functions get the real argument types of the constructor,
\end{code}
These two functions get the real argument types of the constructor,
(map varToCoreExpr (all_tyvars ++ reverse rep_ids))
(tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
(map varToCoreExpr (all_tyvars ++ reverse rep_ids))
(tyvars, _, ex_tyvars, ex_theta, orig_arg_tys, tycon) = dataConSig data_con
- all_tyvars = ex_tyvars ++ tyvars
+ all_tyvars = tyvars ++ ex_tyvars
ex_dict_tys = mkPredTys ex_theta
all_arg_tys = ex_dict_tys ++ orig_arg_tys
ex_dict_tys = mkPredTys ex_theta
all_arg_tys = ex_dict_tys ++ orig_arg_tys
-- Scrutinee type must be a tycon applicn; checked by caller
-- This code is remarkably compact considering what it does!
-- NB: args must be in scope here so that the lintCoreArgs line works.
-- Scrutinee type must be a tycon applicn; checked by caller
-- This code is remarkably compact considering what it does!
-- NB: args must be in scope here so that the lintCoreArgs line works.
+ -- NB: relies on existential type args coming *after* ordinary type args
case splitTyConApp scrut_ty of { (tycon, tycon_arg_tys) ->
lintTyApps (dataConRepType con) tycon_arg_tys `thenL` \ con_type ->
lintCoreArgs con_type (map mk_arg args) `thenL` \ con_result_ty ->
case splitTyConApp scrut_ty of { (tycon, tycon_arg_tys) ->
lintTyApps (dataConRepType con) tycon_arg_tys `thenL` \ con_type ->
lintCoreArgs con_type (map mk_arg args) `thenL` \ con_result_ty ->
-- We generate constraints for the stupid theta even when
-- pattern matching (as the Report requires)
in
-- We generate constraints for the stupid theta even when
-- pattern matching (as the Report requires)
in
- tcInstTyVars VanillaTv (ex_tvs ++ tvs) `thenNF_Tc` \ (all_tvs', ty_args', tenv) ->
+ tcInstTyVars VanillaTv (tvs ++ ex_tvs) `thenNF_Tc` \ (all_tvs', ty_args', tenv) ->
let
stupid_theta' = substTheta tenv stupid_theta
ex_theta' = substTheta tenv ex_theta
arg_tys' = map (substTy tenv) arg_tys
let
stupid_theta' = substTheta tenv stupid_theta
ex_theta' = substTheta tenv ex_theta
arg_tys' = map (substTy tenv) arg_tys
- n_ex_tvs = length ex_tvs
- ex_tvs' = take n_ex_tvs all_tvs'
- result_ty = mkTyConApp tycon (drop n_ex_tvs ty_args')
+ n_normal_tvs = length tvs
+ ex_tvs' = drop n_normal_tvs all_tvs'
+ result_ty = mkTyConApp tycon (take n_normal_tvs ty_args')
in
newDicts orig stupid_theta' `thenNF_Tc` \ stupid_dicts ->
newDicts orig ex_theta' `thenNF_Tc` \ ex_dicts ->
in
newDicts orig stupid_theta' `thenNF_Tc` \ stupid_dicts ->
newDicts orig ex_theta' `thenNF_Tc` \ ex_dicts ->