[commit: ghc] wip/tdammers/D4394: Refactor mkCoCast (5ab47c0)

git at git.haskell.org git at git.haskell.org
Thu Mar 22 11:02:43 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/tdammers/D4394
Link       : http://ghc.haskell.org/trac/ghc/changeset/5ab47c0a152ad8aa7743403b07ad5e1962fb8f28/ghc

>---------------------------------------------------------------

commit 5ab47c0a152ad8aa7743403b07ad5e1962fb8f28
Author: Tobias Dammers <tdammers at gmail.com>
Date:   Tue Mar 6 12:09:56 2018 +0100

    Refactor mkCoCast
    
    Get rid of ugly case pattern matching in favor of simply getting the
    last two arguments unconditionally.


>---------------------------------------------------------------

5ab47c0a152ad8aa7743403b07ad5e1962fb8f28
 compiler/types/Coercion.hs | 19 +++++++------------
 1 file changed, 7 insertions(+), 12 deletions(-)

diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index 1e529f7..33e3802 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -1282,22 +1282,17 @@ mkPiCo r v co | isTyVar v = mkHomoForAllCos [v] co
 -- itself always representational.
 mkCoCast :: Coercion -> CoercionR -> Coercion
 mkCoCast c g
+  | (g2:g1:_) <- reverse co_list
   = mkSymCo g1 `mkTransCo` c `mkTransCo` g2
+
+  | otherwise
+  = pprPanic "mkCoCast" (ppr g $$ ppr (coercionKind g))
   where
-       -- g  :: (s1 ~# t1) ~# (s2 ~# t2)
-       -- g1 :: s1 ~# s2
-       -- g2 :: t1 ~# t2
+    -- g  :: (s1 ~# t1) ~# (s2 ~# t2)
+    -- g1 :: s1 ~# s2
+    -- g2 :: t1 ~# t2
     (tc, _) = splitTyConApp (pFst $ coercionKind g)
-    n_args
-      | tc `hasKey` eqPrimTyConKey     = 4
-      | tc `hasKey` eqReprPrimTyConKey = 4
-      | tc `hasKey` eqTyConKey         = 3
-      | tc `hasKey` heqTyConKey        = 4
-      | tc `hasKey` coercibleTyConKey  = 3
-      | otherwise                      = pprPanic "mkCoCast" (ppr g $$ ppr (coercionKind g))
     co_list = decomposeCo (tyConArity tc) g (tyConRolesRepresentational tc)
-    g1 = co_list `getNth` (n_args - 2)
-    g2 = co_list `getNth` (n_args - 1)
 
 {-
 %************************************************************************



More information about the ghc-commits mailing list