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