[commit: ghc] master: coercion: Improve debugging output (2eafd76)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/2eafd7670e83cb8684585829d5b4bbcc69d34c70/ghc

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

commit 2eafd7670e83cb8684585829d5b4bbcc69d34c70
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Apr 23 09:38:35 2018 -0400

    coercion: Improve debugging output
    
    * Improve assertion-failure message
    * Add HasDebugCallStack to decomposeFunCo
    
    Reviewers: goldfire, bgamari
    
    Subscribers: thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D4570


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

2eafd7670e83cb8684585829d5b4bbcc69d34c70
 compiler/types/Coercion.hs | 82 ++++++++++++++++++++++++++--------------------
 1 file changed, 46 insertions(+), 36 deletions(-)

diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index ff41529..4255e4a 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -239,8 +239,10 @@ decomposeCo arity co rs
   = [mkNthCo r n co | (n,r) <- [0..(arity-1)] `zip` rs ]
            -- Remember, Nth is zero-indexed
 
-decomposeFunCo :: Role  -- of the input coercion
-               -> Coercion -> (Coercion, Coercion)
+decomposeFunCo :: HasDebugCallStack
+               => Role      -- Role of the input coercion
+               -> Coercion  -- Input coercion
+               -> (Coercion, Coercion)
 -- Expects co :: (s1 -> t1) ~ (s2 -> t2)
 -- Returns (co1 :: s1~s2, co2 :: t1~t2)
 -- See Note [Function coercions] for the "2" and "3"
@@ -839,44 +841,11 @@ mkNthCo :: HasDebugCallStack
         -> Coercion
         -> Coercion
 mkNthCo r n co
-  = ASSERT(good_call)
+  = ASSERT2( good_call, bad_call_msg )
     go r n co
   where
     Pair ty1 ty2 = coercionKind co
 
-    good_call
-      -- If the Coercion passed in is between forall-types, then the Int must
-      -- be 0 and the role must be Nominal.
-      | Just (_tv1, _) <- splitForAllTy_maybe ty1
-      , Just (_tv2, _) <- splitForAllTy_maybe ty2
-      = n == 0 && r == Nominal
-
-      -- If the Coercion passed in is between T tys and T tys', then the Int
-      -- must be less than the length of tys/tys' (which must be the same
-      -- lengths).
-      --
-      -- If the role of the Coercion is nominal, then the role passed in must
-      -- be nominal. If the role of the Coercion is representational, then the
-      -- role passed in must be tyConRolesRepresentational T !! n. If the role
-      -- of the Coercion is Phantom, then the role passed in must be Phantom.
-      --
-      -- See also Note [NthCo Cached Roles] if you're wondering why it's
-      -- blaringly obvious that we should be *computing* this role instead of
-      -- passing it in.
-      | Just (tc1, tys1) <- splitTyConApp_maybe ty1
-      , Just (tc2, tys2) <- splitTyConApp_maybe ty2
-      , tc1 == tc2
-      = let len1 = length tys1
-            len2 = length tys2
-            good_role = case coercionRole co of
-                          Nominal -> r == Nominal
-                          Representational -> r == (tyConRolesRepresentational tc1 !! n)
-                          Phantom -> r == Phantom
-        in len1 == len2 && n < len1 && good_role
-
-      | otherwise
-      = True
-
     go r 0 (Refl _ ty)
       | Just (tv, _) <- splitForAllTy_maybe ty
       = ASSERT( r == Nominal )
@@ -930,6 +899,47 @@ mkNthCo r n co
     go r n co =
       NthCo r n co
 
+    -- Assertion checking
+    bad_call_msg = vcat [ text "Coercion =" <+> ppr co
+                        , text "LHS ty =" <+> ppr ty1
+                        , text "RHS ty =" <+> ppr ty2
+                        , text "n =" <+> ppr n, text "r =" <+> ppr r
+                        , text "coercion role =" <+> ppr (coercionRole co) ]
+    good_call
+      -- If the Coercion passed in is between forall-types, then the Int must
+      -- be 0 and the role must be Nominal.
+      | Just (_tv1, _) <- splitForAllTy_maybe ty1
+      , Just (_tv2, _) <- splitForAllTy_maybe ty2
+      = n == 0 && r == Nominal
+
+      -- If the Coercion passed in is between T tys and T tys', then the Int
+      -- must be less than the length of tys/tys' (which must be the same
+      -- lengths).
+      --
+      -- If the role of the Coercion is nominal, then the role passed in must
+      -- be nominal. If the role of the Coercion is representational, then the
+      -- role passed in must be tyConRolesRepresentational T !! n. If the role
+      -- of the Coercion is Phantom, then the role passed in must be Phantom.
+      --
+      -- See also Note [NthCo Cached Roles] if you're wondering why it's
+      -- blaringly obvious that we should be *computing* this role instead of
+      -- passing it in.
+      | Just (tc1, tys1) <- splitTyConApp_maybe ty1
+      , Just (tc2, tys2) <- splitTyConApp_maybe ty2
+      , tc1 == tc2
+      = let len1 = length tys1
+            len2 = length tys2
+            good_role = case coercionRole co of
+                          Nominal -> r == Nominal
+                          Representational -> r == (tyConRolesRepresentational tc1 !! n)
+                          Phantom -> r == Phantom
+        in len1 == len2 && n < len1 && good_role
+
+      | otherwise
+      = True
+
+
+
 -- | If you're about to call @mkNthCo r n co@, then @r@ should be
 -- whatever @nthCoRole n co@ returns.
 nthCoRole :: Int -> Coercion -> Role