nameModule panic with horde-ad

Compiling ghc -O X causes an assertion failure in GHC.Iface.Binary.serialiseName. If assertions are disabled, it causes a panic in nameModule. Reproduced on 9.6 and master, with cherry-picked patch !10017 (closed).

The testcase is a minimized version of horde-ad and its dependencies from #22955 (comment 483278). Unfortunately it's rather fragile and requires plenty of type classes, I wasn't able to improve upon that.

{-# OPTIONS_GHC -fspecialize-aggressively -fexpose-all-unfoldings  #-}
{-# LANGUAGE RankNTypes #-}
module X (testPolyn) where

import Y

testPolyn :: (forall r. Tensor r => r) -> Vector Double
testPolyn f = gradientFromDelta f

{-# OPTIONS_GHC -fspecialize-aggressively -fexpose-all-unfoldings #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances,
             DataKinds, MultiParamTypeClasses, RankNTypes, MonoLocalBinds #-}
module Y where

import System.IO.Unsafe
import Control.Monad.ST ( ST, runST )
import Foreign.ForeignPtr
import Foreign.Storable
import GHC.ForeignPtr ( unsafeWithForeignPtr )

class MyNum a where
  fi :: a

class (MyNum a, Eq a) => MyReal a

class (MyReal a) => MyRealFrac a  where
  fun :: a -> ()

class (MyRealFrac a, MyNum a) => MyRealFloat a

instance MyNum Double
instance MyReal Double
instance MyRealFloat Double
instance MyRealFrac Double

newtype Vector a = Vector (ForeignPtr a)

class GVector v a where
instance Storable a => GVector Vector a

vunstream :: () -> ST s (v a)
vunstream () = vunstream ()

empty :: GVector v a => v a
empty = runST (vunstream ())
{-# NOINLINE empty #-}

instance (Storable a, Eq a) => Eq (Vector a) where
  xs == ys = idx xs == idx ys

{-# NOINLINE idx #-}
idx (Vector fp) = unsafePerformIO
                        $ unsafeWithForeignPtr fp $ \p ->
                          peekElemOff p 0

instance MyNum (Vector Double)
instance (MyNum (Vector a), Storable a, Eq a) => MyReal (Vector a)
instance (MyNum (Vector a), Storable a, Eq a) => MyRealFrac (Vector a)
instance (MyNum (Vector a), Storable a, MyRealFloat a) => MyRealFloat (Vector a)

newtype ORArray a = A a

instance (Eq a) => Eq (ORArray a) where
  A x == A y = x == y

instance (MyNum (Vector a)) => MyNum (ORArray a)
instance (MyNum (Vector a), Storable a, Eq a) => MyReal (ORArray a)
instance (MyRealFrac (Vector a), Storable a, Eq a) => MyRealFrac (ORArray a)
instance (MyRealFloat (Vector a), Storable a, Eq a) => MyRealFloat (ORArray a)

newtype Ast r = AstConst (ORArray r)

instance Eq (Ast a) where
  (==) = undefined

instance MyNum (ORArray a) => MyNum (Ast a) where
  fi = AstConst fi

instance MyNum (ORArray a) => MyReal (Ast a)
instance MyRealFrac (ORArray a) => MyRealFrac (Ast a) where
  {-# INLINE fun #-}
  fun x = ()
  
instance MyRealFloat (ORArray a) => MyRealFloat (Ast a)

class (MyRealFloat a) => Tensor a
instance (MyRealFloat a, MyNum (Vector a), Storable a) => Tensor (Ast a)

gradientFromDelta :: Storable a => Ast a -> Vector a
gradientFromDelta _ = empty
{-# NOINLINE gradientFromDelta #-}

$ ghc -O X
...
<no location info>: error:
    panic! (the 'impossible' happened)
  GHC version 9.7.20230218:
	nameModule
  internal $s$fMyRealFracORArray_$cp1MyRealFrac_sZI
  Call stack:
      CallStack (from HasCallStack):
        callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic
        pprPanic, called at compiler/GHC/Types/Name.hs:329:3 in ghc:GHC.Types.Name
        nameModule, called at compiler/GHC/Iface/Binary.hs:312:16 in ghc:GHC.Iface.Binary