diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-15 13:27:12 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-15 17:36:02 +0100 |
commit | e368f3265b80aeb337fbac3f6a70ee54ab14edfd (patch) | |
tree | c38b396e267a5f8172751daa8f985c22d6f92760 /compiler/vectorise | |
parent | 77bb09270c70455bbd547470c4e995707d19f37d (diff) | |
download | haskell-e368f3265b80aeb337fbac3f6a70ee54ab14edfd.tar.gz |
Major patch to introduce TyConBinder
Before this patch, following the TypeInType innovations,
each TyCon had two lists:
- tyConBinders :: [TyBinder]
- tyConTyVars :: [TyVar]
They were in 1-1 correspondence and contained
overlapping information. More broadly, there were many
places where we had to pass around this pair of lists,
instead of a single list.
This commit tidies all that up, by having just one list of
binders in a TyCon:
- tyConBinders :: [TyConBinder]
The new data types look like this:
Var.hs:
data TyVarBndr tyvar vis = TvBndr tyvar vis
data VisibilityFlag = Visible | Specified | Invisible
type TyVarBinder = TyVarBndr TyVar VisibilityFlag
TyCon.hs:
type TyConBinder = TyVarBndr TyVar TyConBndrVis
data TyConBndrVis
= NamedTCB VisibilityFlag
| AnonTCB
TyCoRep.hs:
data TyBinder
= Named TyVarBinder
| Anon Type
Note that Var.TyVarBdr has moved from TyCoRep and has been
made polymorphic in the tyvar and visiblity fields:
type TyVarBinder = TyVarBndr TyVar VisibilityFlag
-- Used in ForAllTy
type TyConBinder = TyVarBndr TyVar TyConBndrVis
-- Used in TyCon
type IfaceForAllBndr = TyVarBndr IfaceTvBndr VisibilityFlag
type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
-- Ditto, in interface files
There are a zillion knock-on changes, but everything
arises from these types. It was a bit fiddly to get the
module loops to work out right!
Some smaller points
~~~~~~~~~~~~~~~~~~~
* Nice new functions
TysPrim.mkTemplateKiTyVars
TysPrim.mkTemplateTyConBinders
which help you make the tyvar binders for dependently-typed
TyCons. See comments with their definition.
* The change showed up a bug in TcGenGenerics.tc_mkRepTy, where the code
was making an assumption about the order of the kind variables in the
kind of GHC.Generics.(:.:). I fixed this; see TcGenGenerics.mkComp.
Diffstat (limited to 'compiler/vectorise')
-rw-r--r-- | compiler/vectorise/Vectorise/Generic/PData.hs | 7 | ||||
-rw-r--r-- | compiler/vectorise/Vectorise/Type/Env.hs | 2 | ||||
-rw-r--r-- | compiler/vectorise/Vectorise/Type/TyConDecl.hs | 8 |
3 files changed, 7 insertions, 10 deletions
diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs index 23cd0a2cb0..9fbe1283f2 100644 --- a/compiler/vectorise/Vectorise/Generic/PData.hs +++ b/compiler/vectorise/Vectorise/Generic/PData.hs @@ -51,9 +51,8 @@ buildDataFamInst name' fam_tc vect_tc rhs rep_ty = mkTyConApp rep_tc tys' pat_tys = [mkTyConApp vect_tc tys'] rep_tc = mkAlgTyCon name' - (mkTyBindersPreferAnon tyvars' liftedTypeKind) + (mkTyConBindersPreferAnon tyvars' liftedTypeKind) liftedTypeKind - tyvars' (map (const Nominal) tyvars') Nothing [] -- no stupid theta @@ -85,7 +84,7 @@ buildPDataDataCon orig_name vect_tc repr_tc repr (map (const no_bang) comp_tys) (Just $ map (const HsLazy) comp_tys) [] -- no field labels - tvs (map (mkNamedBinder . mkTyVarBinder Specified) tvs) + (mkTyVarBinders Specified tvs) [] -- no existentials [] -- no eq spec [] -- no context @@ -129,7 +128,7 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr (map (const no_bang) comp_tys) (Just $ map (const HsLazy) comp_tys) [] -- no field labels - tvs (map (mkNamedBinder . mkTyVarBinder Specified) tvs) + (mkTyVarBinders Specified tvs) [] -- no existentials [] -- no eq spec [] -- no context diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index 0bcdf0c4a8..b6c8bec3fc 100644 --- a/compiler/vectorise/Vectorise/Type/Env.hs +++ b/compiler/vectorise/Vectorise/Type/Env.hs @@ -360,7 +360,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls origName = tyConName origTyCon vectName = tyConName vectTyCon - mkSyn canonName ty = mkSynonymTyCon canonName [] (typeKind ty) [] [] ty + mkSyn canonName ty = mkSynonymTyCon canonName [] (typeKind ty) [] ty defDataCons | isAbstract = return () diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs index 052eced404..3085beb183 100644 --- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs +++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs @@ -61,10 +61,9 @@ vectTyConDecl tycon name' ; cls' <- liftDs $ buildClass name' -- new name: "V:Class" - (tyConTyVars tycon) -- keep original type vars + (tyConBinders tycon) -- keep original kind (map (const Nominal) (tyConRoles tycon)) -- all role are N for safety theta' -- superclasses - (tyConBinders tycon) -- keep original kind (snd . classTvsFds $ cls) -- keep the original functional dependencies [] -- no associated types (for the moment) methods' -- method info @@ -105,7 +104,6 @@ vectTyConDecl tycon name' name' -- new name (tyConBinders tycon) (tyConResKind tycon) -- keep original kind - (tyConTyVars tycon) -- keep original type vars (map (const Nominal) (tyConRoles tycon)) -- all roles are N for safety Nothing [] -- no stupid theta @@ -191,7 +189,7 @@ vectDataCon dc (dataConSrcBangs dc) -- strictness as original constructor (Just $ dataConImplBangs dc) [] -- no labelled fields for now - univ_tvs univ_bndrs -- universally quantified vars + univ_bndrs -- universally quantified vars [] -- no existential tvs for now [] -- no equalities for now [] -- no context for now @@ -204,4 +202,4 @@ vectDataCon dc rep_arg_tys = dataConRepArgTys dc tycon = dataConTyCon dc (univ_tvs, ex_tvs, eq_spec, theta, _arg_tys, _res_ty) = dataConFullSig dc - univ_bndrs = map mkNamedBinder (dataConUnivTyVarBinders dc) + univ_bndrs = dataConUnivTyVarBinders dc |