Commit 489a9a3b authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent c9ac9de7
...@@ -1035,7 +1035,7 @@ flatten_ty_con_app tc tys ...@@ -1035,7 +1035,7 @@ flatten_ty_con_app tc tys
; let role = eqRelRole eq_rel ; let role = eqRelRole eq_rel
; (xis, cos) <- case eq_rel of ; (xis, cos) <- case eq_rel of
NomEq -> flatten_many_nom tys 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) } ; return (mkTyConApp tc xis, mkTyConAppCo role tc cos) }
{- {-
......
...@@ -53,7 +53,7 @@ module Coercion ( ...@@ -53,7 +53,7 @@ module Coercion (
splitAppCo_maybe, splitAppCo_maybe,
splitForAllCo_maybe, splitForAllCo_maybe,
nthRole, tyConRolesX, setNominalRole_maybe, nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe,
pickLR, pickLR,
...@@ -609,7 +609,7 @@ mkAppCo (TyConAppCo r tc args) arg ...@@ -609,7 +609,7 @@ mkAppCo (TyConAppCo r tc args) arg
= case r of = case r of
Nominal -> TyConAppCo Nominal tc (args ++ [arg]) Nominal -> TyConAppCo Nominal tc (args ++ [arg])
Representational -> TyConAppCo Representational 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 arg' = downgradeRole new_role Nominal arg
Phantom -> TyConAppCo Phantom tc (args ++ [toPhantomCo arg]) Phantom -> TyConAppCo Phantom tc (args ++ [toPhantomCo arg])
mkAppCo co arg = AppCo co arg mkAppCo co arg = AppCo co arg
...@@ -670,13 +670,13 @@ mkTransAppCo r1 co1 ty1a ty1b r2 co2 ty2a ty2b r3 ...@@ -670,13 +670,13 @@ mkTransAppCo r1 co1 ty1a ty1b r2 co2 ty2a ty2b r3
, nextRole ty1b == r2 , nextRole ty1b == r2
= (mkAppCo co1_repr (mkNomReflCo ty2a)) `mkTransCo` = (mkAppCo co1_repr (mkNomReflCo ty2a)) `mkTransCo`
(mkTyConAppCo Representational tc1b (mkTyConAppCo Representational tc1b
(zipWith mkReflCo (tyConRolesX Representational tc1b) tys1b (zipWith mkReflCo (tyConRolesRepresentational tc1b) tys1b
++ [co2])) ++ [co2]))
| Just (tc1a, tys1a) <- splitTyConApp_maybe ty1a | Just (tc1a, tys1a) <- splitTyConApp_maybe ty1a
, nextRole ty1a == r2 , nextRole ty1a == r2
= (mkTyConAppCo Representational tc1a = (mkTyConAppCo Representational tc1a
(zipWith mkReflCo (tyConRolesX Representational tc1a) tys1a (zipWith mkReflCo (tyConRolesRepresentational tc1a) tys1a
++ [co2])) ++ [co2]))
`mkTransCo` `mkTransCo`
(mkAppCo co1_repr (mkNomReflCo ty2b)) (mkAppCo co1_repr (mkNomReflCo ty2b))
...@@ -1053,20 +1053,23 @@ toPhantomCo co ...@@ -1053,20 +1053,23 @@ toPhantomCo co
-- Convert args to a TyConAppCo Nominal to the same TyConAppCo Representational -- Convert args to a TyConAppCo Nominal to the same TyConAppCo Representational
applyRoles :: TyCon -> [Coercion] -> [Coercion] applyRoles :: TyCon -> [Coercion] -> [Coercion]
applyRoles tc cos 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 -- the Role parameter is the Role of the TyConAppCo
-- defined here because this is intimiately concerned with the implementation -- defined here because this is intimiately concerned with the implementation
-- of TyConAppCo -- of TyConAppCo
tyConRolesX :: Role -> TyCon -> [Role] tyConRolesX :: Role -> TyCon -> [Role]
tyConRolesX Representational tc = tyConRoles tc ++ repeat Nominal tyConRolesX Representational tc = tyConRolesRepresentational tc
tyConRolesX role _ = repeat role tyConRolesX role _ = repeat role
tyConRolesRepresentational :: TyCon -> [Role]
tyConRolesRepresentational tc = tyConRoles tc ++ repeat Nominal
nthRole :: Role -> TyCon -> Int -> Role nthRole :: Role -> TyCon -> Int -> Role
nthRole Nominal _ _ = Nominal nthRole Nominal _ _ = Nominal
nthRole Phantom _ _ = Phantom nthRole Phantom _ _ = Phantom
nthRole Representational tc n nthRole Representational tc n
= (tyConRolesX Representational tc) `getNth` n = (tyConRolesRepresentational tc) `getNth` n
ltRole :: Role -> Role -> Bool ltRole :: Role -> Role -> Bool
-- Is one role "less" than another? -- Is one role "less" than another?
......
...@@ -180,7 +180,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos) ...@@ -180,7 +180,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos)
(True, Nominal) -> (True, Nominal) ->
mkTyConAppCo Representational tc mkTyConAppCo Representational tc
(zipWith3 (opt_co3 env sym) (zipWith3 (opt_co3 env sym)
(map Just (tyConRolesX Representational tc)) (map Just (tyConRolesRepresentational tc))
(repeat Nominal) (repeat Nominal)
cos) cos)
(False, Nominal) -> (False, Nominal) ->
...@@ -189,7 +189,7 @@ opt_co4 env sym rep r g@(TyConAppCo _r tc cos) ...@@ -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 -- must use opt_co2 here, because some roles may be P
-- See Note [Optimising coercion optimisation] -- See Note [Optimising coercion optimisation]
mkTyConAppCo r tc (zipWith (opt_co2 env sym) mkTyConAppCo r tc (zipWith (opt_co2 env sym)
(tyConRolesX r tc) -- the current roles (tyConRolesRepresentational tc) -- the current roles
cos) cos)
(_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g) (_, Phantom) -> pprPanic "opt_co4 sees a phantom!" (ppr g)
......
...@@ -673,11 +673,12 @@ test('T9872a', ...@@ -673,11 +673,12 @@ test('T9872a',
test('T9872b', test('T9872b',
[ only_ways(['normal']), [ only_ways(['normal']),
compiler_stats_num_field('bytes allocated', compiler_stats_num_field('bytes allocated',
[(wordsize(64), 5199926080, 5), [(wordsize(64), 4918990352, 5),
# 2014-12-10 6483306280 Initally created # 2014-12-10 6483306280 Initally created
# 2014-12-16 6892251912 Flattener parameterized over roles # 2014-12-16 6892251912 Flattener parameterized over roles
# 2014-12-18 3480212048 Reduce type families even more eagerly # 2014-12-18 3480212048 Reduce type families even more eagerly
# 2015-12-11 5199926080 TypeInType (see #11196) # 2015-12-11 5199926080 TypeInType (see #11196)
# 2016-02-08 4918990352 Improved a bit by tyConRolesRepresentational
(wordsize(32), 1700000000, 5) (wordsize(32), 1700000000, 5)
]), ]),
], ],
...@@ -686,11 +687,12 @@ test('T9872b', ...@@ -686,11 +687,12 @@ test('T9872b',
test('T9872c', test('T9872c',
[ only_ways(['normal']), [ only_ways(['normal']),
compiler_stats_num_field('bytes allocated', compiler_stats_num_field('bytes allocated',
[(wordsize(64), 4723613784, 5), [(wordsize(64), 4454071184, 5),
# 2014-12-10 5495850096 Initally created # 2014-12-10 5495850096 Initally created
# 2014-12-16 5842024784 Flattener parameterized over roles # 2014-12-16 5842024784 Flattener parameterized over roles
# 2014-12-18 2963554096 Reduce type families even more eagerly # 2014-12-18 2963554096 Reduce type families even more eagerly
# 2015-12-11 4723613784 TypeInType (see #11196) # 2015-12-11 4723613784 TypeInType (see #11196)
# 2016-02-08 4454071184 Improved a bit by tyConRolesRepresentational
(wordsize(32), 1500000000, 5) (wordsize(32), 1500000000, 5)
]), ]),
], ],
...@@ -699,11 +701,12 @@ test('T9872c', ...@@ -699,11 +701,12 @@ test('T9872c',
test('T9872d', test('T9872d',
[ only_ways(['normal']), [ only_ways(['normal']),
compiler_stats_num_field('bytes allocated', compiler_stats_num_field('bytes allocated',
[(wordsize(64), 566134504, 5), [(wordsize(64), 534693648, 5),
# 2014-12-18 796071864 Initally created # 2014-12-18 796071864 Initally created
# 2014-12-18 739189056 Reduce type families even more eagerly # 2014-12-18 739189056 Reduce type families even more eagerly
# 2015-01-07 687562440 TrieMap leaf compression # 2015-01-07 687562440 TrieMap leaf compression
# 2015-03-17 726679784 tweak to solver; probably flattens more # 2015-03-17 726679784 tweak to solver; probably flattens more
# 2016-02-08 534693648 Improved a bit by tyConRolesRepresentational
(wordsize(32), 59651432, 5) (wordsize(32), 59651432, 5)
# some date 328810212 # some date 328810212
# 2015-07-11 350369584 # 2015-07-11 350369584
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment