[GHC] #11230: No run-time exception for deferred type errors when error is in a phantom role position
GHC
ghc-devs at haskell.org
Tue Dec 15 15:01:58 UTC 2015
#11230: No run-time exception for deferred type errors when error is in a phantom
role position
-------------------------------------+-------------------------------------
Reporter: darchon | Owner:
Type: bug | Status: new
Priority: normal | Milestone: 8.0.1
Component: Compiler | Version: 7.11
Resolution: | Keywords: deferred,
| roles
Operating System: Unknown/Multiple | Architecture:
Type of failure: Incorrect result | Unknown/Multiple
at runtime | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Description changed by darchon:
Old description:
> The following code:
>
> {{{#!hs
> {-# 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 msg) -> putStrLn (c ++ "(Succes): exception found")
> -- #else
> -- Left (ErrorCall _) -> putStrLn "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:
>
> {{{
> Succes: exception found
> 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 {
> }
> }}}
New description:
The following code:
{{{#!hs
{-# 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 {
}
}}}
--
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11230#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list