No run-time exception for deferred type errors when error is in a phantom role position
The following code:
{-# LANGUAGE RoleAnnotations #-}
{-# OPTIONS_GHC -fdefer-type-errors #-}
import Control.Exception
newtype Representational a = Representational ()
type role Representational representational
newtype Phantom a = Phantom ()
type role Phantom phantom
testRepresentational :: Representational Char -> Representational Bool
testRepresentational = id
{-# NOINLINE testRepresentational #-}
testPhantom :: Phantom Char -> Phantom Bool
testPhantom = id
{-# NOINLINE testPhantom #-}
throwsException :: String -> a -> IO ()
throwsException c v = do
result <- try (evaluate v)
case result of
Right _ -> error (c ++ " (Failure): No exception!")
-- #if MIN_VERSION_base(4,9,0)
Left (TypeError _) -> putStrLn (c ++ "(Succes): exception found")
-- #else
-- Left (ErrorCall _) -> putStrLn (c ++ " (Succes): exception found")
-- #endif
main = do
throwsException "representational" testRepresentational
throwsException "phantom" testPhantom
Produces the following result in HEAD:
representational(Succes): exception found
*** Exception: phantom (Failure): No exception!
CallStack (from ImplicitParams):
error, called at Main.hs:24:16 in main:Main
In 7.10.2 (after commenting the TypeError
line, and uncommenting the ErrorCall
line), we get the following output:
representational (Succes): exception found
phantom (Succes): exception found
I think the HEAD result is wrong: deferred type errors should always result in a run-time exception when their associated value is evaluated, regardless of whether the error occurred in a phantom role position or not.
Looking at the core (ghc -O0 -ddump-simpl
) in HEAD is see:
-- RHS size: {terms: 3, types: 15, coercions: 0}
testRepresentational_rqP
:: Representational Char -> Representational Bool
[GblId, Str=DmdType b]
testRepresentational_rqP =
case typeError
@ 'Unlifted
@ (Char ~# Bool)
"Main.hs:13:24: error:\n\
\ \\226\\128\\162 Couldn't match type \\226\\128\\152Char\\226\\128\\153 with \\226\\128\\152Bool\\226\\128\\153\n\
\ Expected type: Representational Char -> Representational Bool\n\
\ Actual type: Representational Bool -> Representational Bool\n\
\ \\226\\128\\162 In the expression: id\n\
\ In an equation for \\226\\128\\152testRepresentational\\226\\128\\153:\n\
\ testRepresentational = id\n\
\(deferred type error)"#
of wild0_00 {
}
-- RHS size: {terms: 1, types: 2, coercions: 10}
testPhantom_rqQ :: Phantom Char -> Phantom Bool
[GblId, Str=DmdType]
testPhantom_rqQ =
(id @ (Phantom Bool))
`cast` ((Phantom <Bool, Char>_P{<*>_N})_R -> <Phantom Bool>_R
:: (Phantom Bool -> Phantom Bool)
~R# (Phantom Char -> Phantom Bool))
while in 7.10.2 I see:
testRepresentational_rnc
:: Representational Char -> Representational Bool
[GblId, Str=DmdType b]
testRepresentational_rnc =
case Control.Exception.Base.runtimeError
@ (Char ~ Bool)
"Main.hs:13:24:\n\
\ Couldn't match type \\226\\128\\152Char\\226\\128\\153 with \\226\\128\\152Bool\\226\\128\\153\n\
\ Expected type: Representational Char -> Representational Bool\n\
\ Actual type: Representational Bool -> Representational Bool\n\
\ In the expression: id\n\
\ In an equation for \\226\\128\\152testRepresentational\\226\\128\\153:\n\
\ testRepresentational = id\n\
\(deferred type error)"#
of wild_00 {
}
testPhantom_rnd :: Phantom Char -> Phantom Bool
[GblId, Str=DmdType b]
testPhantom_rnd =
case Control.Exception.Base.runtimeError
@ (Char ~ Bool)
"Main.hs:17:15:\n\
\ Couldn't match type \\226\\128\\152Char\\226\\128\\153 with \\226\\128\\152Bool\\226\\128\\153\n\
\ Expected type: Phantom Char -> Phantom Bool\n\
\ Actual type: Phantom Bool -> Phantom Bool\n\
\ In the expression: id\n\
\ In an equation for \\226\\128\\152testPhantom\\226\\128\\153: testPhantom = id\n\
\(deferred type error)"#
of wild_00 {
}