[commit: ghc] ghc-8.0: Define tyConRolesRepresentational and use it (1b75e1d)
git at git.haskell.org
git at git.haskell.org
Thu Mar 24 22:00:25 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/1b75e1d713635a86ea21b1e98689ab3330c92cac/ghc
>---------------------------------------------------------------
commit 1b75e1d713635a86ea21b1e98689ab3330c92cac
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Feb 8 17:41:58 2016 +0000
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.
>---------------------------------------------------------------
1b75e1d713635a86ea21b1e98689ab3330c92cac
compiler/typecheck/TcFlatten.hs | 2 +-
compiler/types/Coercion.hs | 17 ++++++++++-------
compiler/types/OptCoercion.hs | 4 ++--
3 files changed, 13 insertions(+), 10 deletions(-)
diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs
index 6af8660..76eda37 100644
--- a/compiler/typecheck/TcFlatten.hs
+++ b/compiler/typecheck/TcFlatten.hs
@@ -1046,7 +1046,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 471ce45..fe9cc41 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,
@@ -608,7 +608,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
@@ -669,13 +669,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))
@@ -1052,20 +1052,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 2ae67d2..fb6c68e 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)
More information about the ghc-commits
mailing list