From 489a9a3beeeae3d150761ef863b4757eba0b02d9 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Mon, 8 Feb 2016 17:41:58 +0000 Subject: [PATCH] Define tyConRolesRepresentational and use it tyConRolesRepresentational is just a version of tyConRolesX, but specialised for a Representational argument. Saves a bit of extra argument passing and pattern matching, and tyConRolesX was often called when we knew the argument role was Representational. Rather to my surprise this made the compiler allocate 5% less for tests T9872{b,c,d}. At least I think it's this commit. Good thing, regardless. --- compiler/typecheck/TcFlatten.hs | 2 +- compiler/types/Coercion.hs | 17 ++++++++++------- compiler/types/OptCoercion.hs | 4 ++-- testsuite/tests/perf/compiler/all.T | 9 ++++++--- 4 files changed, 19 insertions(+), 13 deletions(-) diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs index 76a339da3f..169232ed56 100644 --- a/compiler/typecheck/TcFlatten.hs +++ b/compiler/typecheck/TcFlatten.hs @@ -1035,7 +1035,7 @@ flatten_ty_con_app tc tys ; let role = eqRelRole eq_rel ; (xis, cos) <- case eq_rel of NomEq -> flatten_many_nom tys - ReprEq -> flatten_many (tyConRolesX role tc) tys + ReprEq -> flatten_many (tyConRolesRepresentational tc) tys ; return (mkTyConApp tc xis, mkTyConAppCo role tc cos) } {- diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index c8e48c0b7a..2989bce41e 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -53,7 +53,7 @@ module Coercion ( splitAppCo_maybe, splitForAllCo_maybe, - nthRole, tyConRolesX, setNominalRole_maybe, + nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe, pickLR, @@ -609,7 +609,7 @@ mkAppCo (TyConAppCo r tc args) arg = case r of Nominal -> TyConAppCo Nominal tc (args ++ [arg]) Representational -> TyConAppCo Representational tc (args ++ [arg']) - where new_role = (tyConRolesX Representational tc) !! (length args) + where new_role = (tyConRolesRepresentational tc) !! (length args) arg' = downgradeRole new_role Nominal arg Phantom -> TyConAppCo Phantom tc (args ++ [toPhantomCo arg]) mkAppCo co arg = AppCo co arg @@ -670,13 +670,13 @@ mkTransAppCo r1 co1 ty1a ty1b r2 co2 ty2a ty2b r3 , nextRole ty1b == r2 = (mkAppCo co1_repr (mkNomReflCo ty2a)) `mkTransCo` (mkTyConAppCo Representational tc1b - (zipWith mkReflCo (tyConRolesX Representational tc1b) tys1b + (zipWith mkReflCo (tyConRolesRepresentational tc1b) tys1b ++ [co2])) | Just (tc1a, tys1a) <- splitTyConApp_maybe ty1a , nextRole ty1a == r2 = (mkTyConAppCo Representational tc1a - (zipWith mkReflCo (tyConRolesX Representational tc1a) tys1a + (zipWith mkReflCo (tyConRolesRepresentational tc1a) tys1a ++ [co2])) `mkTransCo` (mkAppCo co1_repr (mkNomReflCo ty2b)) @@ -1053,20 +1053,23 @@ toPhantomCo co -- Convert args to a TyConAppCo Nominal to the same TyConAppCo Representational applyRoles :: TyCon -> [Coercion] -> [Coercion] applyRoles tc cos - = zipWith (\r -> downgradeRole r Nominal) (tyConRolesX Representational tc) cos + = zipWith (\r -> downgradeRole r Nominal) (tyConRolesRepresentational tc) cos -- the Role parameter is the Role of the TyConAppCo -- defined here because this is intimiately concerned with the implementation -- of TyConAppCo tyConRolesX :: Role -> TyCon -> [Role] -tyConRolesX Representational tc = tyConRoles tc ++ repeat Nominal +tyConRolesX Representational tc = tyConRolesRepresentational tc tyConRolesX role _ = repeat role +tyConRolesRepresentational :: TyCon -> [Role] +tyConRolesRepresentational tc = tyConRoles tc ++ repeat Nominal + nthRole :: Role -> TyCon -> Int -> Role nthRole Nominal _ _ = Nominal nthRole Phantom _ _ = Phantom nthRole Representational tc n - = (tyConRolesX Representational tc) `getNth` n + = (tyConRolesRepresentational tc) `getNth` n ltRole :: Role -> Role -> Bool -- Is one role "less" than another? diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs index fc6da629ac..210fc22e7c 100644 --- a/compiler/types/OptCoercion.hs +++ b/compiler/types/OptCoercion.hs @@ -180,7 +180,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos) (True, Nominal) -> mkTyConAppCo Representational tc (zipWith3 (opt_co3 env sym) - (map Just (tyConRolesX Representational tc)) + (map Just (tyConRolesRepresentational tc)) (repeat Nominal) cos) (False, Nominal) -> @@ -189,7 +189,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos) -- must use opt_co2 here, because some roles may be P -- See Note [Optimising coercion optimisation] mkTyConAppCo r tc (zipWith (opt_co2 env sym) - (tyConRolesX r tc) -- the current roles + (tyConRolesRepresentational tc) -- the current roles cos) (_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 7699aff9d9..44b3e75275 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -673,11 +673,12 @@ test('T9872a', test('T9872b', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 5199926080, 5), + [(wordsize(64), 4918990352, 5), # 2014-12-10 6483306280 Initally created # 2014-12-16 6892251912 Flattener parameterized over roles # 2014-12-18 3480212048 Reduce type families even more eagerly # 2015-12-11 5199926080 TypeInType (see #11196) + # 2016-02-08 4918990352 Improved a bit by tyConRolesRepresentational (wordsize(32), 1700000000, 5) ]), ], @@ -686,11 +687,12 @@ test('T9872b', test('T9872c', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 4723613784, 5), + [(wordsize(64), 4454071184, 5), # 2014-12-10 5495850096 Initally created # 2014-12-16 5842024784 Flattener parameterized over roles # 2014-12-18 2963554096 Reduce type families even more eagerly # 2015-12-11 4723613784 TypeInType (see #11196) + # 2016-02-08 4454071184 Improved a bit by tyConRolesRepresentational (wordsize(32), 1500000000, 5) ]), ], @@ -699,11 +701,12 @@ test('T9872c', test('T9872d', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 566134504, 5), + [(wordsize(64), 534693648, 5), # 2014-12-18 796071864 Initally created # 2014-12-18 739189056 Reduce type families even more eagerly # 2015-01-07 687562440 TrieMap leaf compression # 2015-03-17 726679784 tweak to solver; probably flattens more + # 2016-02-08 534693648 Improved a bit by tyConRolesRepresentational (wordsize(32), 59651432, 5) # some date 328810212 # 2015-07-11 350369584 -- GitLab