Desugarer needs an extra case for casts in coercions

Ganesh (via Darcs) found the code below crashes GHC 7.6rc1, thus:

ghc-stage1: panic! (the 'impossible' happened)
  (GHC version 7.6.0 for x86_64-unknown-linux):
	coVarsOfTcCo:Bind
    cobox{v agK} [lid]
      = cobox{v agY} [lid] `cast` (<main:Patch.WithState{tc reC}
                                      (main:Patch.ModelOf{tc reH} prim{tv t1h} [tv])
                                      prim{tv t1h} [tv]>
                                   ghc-prim:GHC.Types.~{(w) tc 31Q} main:Patch.WithState{tc reC}
                                                                      (main:Patch.ModelOf{tc reH}
                                                                         (Sym cobox{v agV} [lid]))
                                                                      <prim{tv t1h} [tv]>)

Problem is a missing case in DsBinds.ds_tc_coercion.

Here's the test case

{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}

module Patch (qc_prim) where

class PrimPatch (prim :: * -> * -> *)

class PrimPatch (PrimOf p) => PrimPatchBase p where
    type PrimOf (p :: * -> * -> *) :: * -> * -> *

type TestGenerator thing gen = (forall t ctx . (forall xx yy . thing xx yy -> t) -> (gen ctx -> t))

type family ModelOf (patch :: * -> * -> *) :: * -> *

data WithState s p x y = WithState {
                              _wsStartState :: s x
                            , _wsPatch      :: p x y
                            , _wsEndState   :: s y
                            }

arbitraryThing :: x -> TestGenerator thing (thing x)
arbitraryThing _ f p = f p

qc_prim :: forall prim x y .
           (PrimPatch prim
           , PrimOf prim ~ prim
           ) => prim x y -> [()]
qc_prim _ =
  concat
  [
   patch_repo_properties      (undefined :: prim x a)    "arbitrary"    arbitraryThing'
  ]
      where arbitraryThing' = arbitraryThing (undefined :: a)

patch_repo_properties :: p x y -> String -> TestGenerator (WithState (ModelOf (PrimOf p)) p) gen -> [()]
patch_repo_properties _ _genname _gen = undefined

Thanks to Ganesh for isolating it out of Darcs.

Trac metadata

Trac field	Value
Version	7.4.2
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture