Instances getting incorrect IPE data
Code:
{-# LANGUAGE AllowAmbiguousTypes #-}
module Main where
import GHC.InfoProv
import Unsafe.Coerce
-- Boilerplate to help us access the literal dictionaries
data Dict c where
Dict :: forall c. c => Dict c
data Box where
Box :: forall a. a -> Box
mkBox :: forall a. a => Box
mkBox = unsafeCoerce (Dict @a)
-- Interesting bit
data A = A
instance Eq A where
A == A = True
instance Ord A where
A <= A = undefined
main :: IO ()
main = do
(\(Box d) -> print =<< whereFrom d) $ mkBox @(Eq A)
(\(Box d) -> print =<< whereFrom d) $ mkBox @(Ord A)
This program prints the IPE data of the Eq A
and Ord A
dictionaries. The Eq A
dictionary looks as we would expect, with ipLabel = $fEqA
. The Ord A
dictionary, however, gets the label <
. Compile with:
ghc -O -fforce-recomp -finfo-table-map -fdistinct-constructor-tables Main.hs
The program outputs:
Just (InfoProv {ipName = "C:Eq_Main_0_con_info", ipDesc = CONSTR_2_0, ipTyDesc = "Eq", ipLabel = "$fEqA", ipMod = "Main", ipSrcFile = "Main.hs", ipSrcSpan = "23:10-13"})
Just (InfoProv {ipName = "C:Ord_Main_0_con_info", ipDesc = CONSTR, ipTyDesc = "Ord", ipLabel = "<", ipMod = "Main", ipSrcFile = "Main.hs", ipSrcSpan = "26:10-14"})
I would expect the Ord
label to be $fOrdA
, not <
.
Interestingly, if we add more explicit definitions to the Ord A
instance, the label changes. Changing the instance to:
instance Ord A where
A <= A = undefined
compare = undefined
Changes the label to >
instead of <
:
Just (InfoProv {ipName = "C:Ord_Main_0_con_info", ipDesc = CONSTR, ipTyDesc = "Ord", ipLabel = ">", ipMod = "Main", ipSrcFile = "Main.hs", ipSrcSpan = "26:10-14"})
Edited by Finley McIlwaine