From d8c64e86361f6766ebe26a262bb229fb8301a42a Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Thu, 4 Feb 2016 10:42:56 -0500 Subject: Address #11471 by putting RuntimeRep in kinds. See Note [TYPE] in TysPrim. There are still some outstanding pieces in #11471 though, so this doesn't actually nail the bug. This commit also contains a few performance improvements: * Short-cut equality checking of nullary type syns * Compare types before kinds in eqType * INLINE coreViewOneStarKind * Store tycon binders separately from kinds. This resulted in a ~10% performance improvement in compiling the Cabal package. No change in functionality other than performance. (This affects the interface file format, though.) This commit updates the haddock submodule. --- compiler/vectorise/Vectorise/Exp.hs | 2 +- compiler/vectorise/Vectorise/Generic/PData.hs | 3 ++- compiler/vectorise/Vectorise/Type/Env.hs | 2 +- compiler/vectorise/Vectorise/Type/TyConDecl.hs | 5 +++-- 4 files changed, 7 insertions(+), 5 deletions(-) (limited to 'compiler/vectorise') diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs index 5f283c6d3a..9daa16a170 100644 --- a/compiler/vectorise/Vectorise/Exp.hs +++ b/compiler/vectorise/Vectorise/Exp.hs @@ -360,7 +360,7 @@ vectExpr (_, AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType ty)) err) | v == pAT_ERROR_ID = do { (vty, lty) <- vectAndLiftType ty - ; return (mkCoreApps (Var v) [Type (getLevity "vectExpr" vty), Type vty, err'], mkCoreApps (Var v) [Type lty, err']) + ; return (mkCoreApps (Var v) [Type (getRuntimeRep "vectExpr" vty), Type vty, err'], mkCoreApps (Var v) [Type lty, err']) } where err' = deAnnotate err diff --git a/compiler/vectorise/Vectorise/Generic/PData.hs b/compiler/vectorise/Vectorise/Generic/PData.hs index a8bffbe962..4f3112850d 100644 --- a/compiler/vectorise/Vectorise/Generic/PData.hs +++ b/compiler/vectorise/Vectorise/Generic/PData.hs @@ -51,7 +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' - (mkPiTypesPreferFunTy tyvars' liftedTypeKind) + (mkTyBindersPreferAnon tyvars' liftedTypeKind) + liftedTypeKind tyvars' (map (const Nominal) tyvars') Nothing diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index 7b00a5c1ef..0bcdf0c4a8 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 03e7d27d0e..4847aa87f1 100644 --- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs +++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs @@ -64,7 +64,7 @@ vectTyConDecl tycon name' (tyConTyVars tycon) -- keep original type vars (map (const Nominal) (tyConRoles tycon)) -- all role are N for safety theta' -- superclasses - (tyConKind tycon) -- keep original kind + (tyConBinders tycon) -- keep original kind (snd . classTvsFds $ cls) -- keep the original functional dependencies [] -- no associated types (for the moment) methods' -- method info @@ -103,7 +103,8 @@ vectTyConDecl tycon name' ; tc_rep_name <- mkDerivedName mkTyConRepOcc name' ; return $ mkAlgTyCon name' -- new name - (tyConKind tycon) -- keep original kind + (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 -- cgit v1.2.1