[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