Simplifier generates incorrect (albeit transient) cast
As of GHC 75f0091b, compiling the
following program with comp
marked as OPAQUE
results in a warning
about an incorrect cast generated by the simplifier:
{-# LANGUAGE NoImplicitPrelude #-}
module Endo where
newtype Endo a = Endo { appEndo :: a -> a }
foo :: Endo a -> Endo a -> Endo a
foo (Endo f) (Endo g) = Endo (comp f g)
comp :: (b -> c) -> (a -> b) -> (a -> c)
comp f g x = f (g x)
{-# OPAQUE comp #-}
Compiling with -ddump-simpl-trace -O
I get the same warning message
repeated for the various simplifier iterations:
==================== Simpl Trace ====================
tcww:no
bndr: Endo.comp
rhs: \ (@b_ahm)
(@c_ahn)
(@a_aho)
(f_at :: b_ahm -> c_ahn)
(g_au :: a_aho -> b_ahm)
(x_av :: a_aho) ->
f_at (g_au x_av)
WARNING:
Trying to coerce
(comp @a_ahr @a_ahr
:: forall a. (a_ahr -> a_ahr) -> (a -> a_ahr) -> a -> a_ahr)
forall (a :: <Type>_N).
Sym (N:Endo[0] <a>_R)
%<'Many>_N ->_R Sym (N:Endo[0] <a>_R)
%<'Many>_N ->_R Sym (N:Endo[0] <a>_R)
(forall {a}. (a -> a) -> (a -> a) -> a -> a :: Type)
~R# (forall {a}. Endo a -> Endo a -> Endo a :: Type)
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/GHC/Core/Utils.hs:311:14 in ghc:GHC.Core.Utils
Call stack:
CallStack (from HasCallStack):
warnPprTrace, called at compiler/GHC/Core/Utils.hs:307:5 in ghc:GHC.Core.Utils
Note that comp @a_ahr @a_ahr
is only partially instantiated, hence its residual polymorphic type forall a. (a_ahr -> a_ahr) -> (a -> a_ahr) -> (a -> a_ahr)
. The cast seems to assume it should be \@a -> comp @a @a @a
instead.
I don't see any problem in the input and the output (and neither does
-dcore-lint
), so it seems the wrong cast is some intermediate
expression that is then processed further by the simplifier. Still, is
this the sign of a bug in waiting?
-- RHS size: {terms: 9, types: 8, coercions: 0, joins: 0/0}
comp [InlPrag=OPAQUE]
:: forall b c a. (b -> c) -> (a -> b) -> a -> c
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)}]
comp
= \ (@b_ahe)
(@c_ahf)
(@a_ahg)
(f_ag :: b_ahe -> c_ahf)
(g_ah :: a_ahg -> b_ahe)
(x_ai :: a_ahg) ->
f_ag (g_ah x_ai)
-- RHS size: {terms: 6, types: 8, coercions: 7, joins: 0/0}
foo :: forall a. Endo a -> Endo a -> Endo a
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
foo
= \ (@a_ahj) (ds_dhw :: Endo a_ahj) (ds_dhx :: Endo a_ahj) ->
(comp
@a_ahj
@a_ahj
@a_ahj
(ds_dhw
`cast` (Endo.N:Endo[0] <a_ahj>_R
:: Endo a_ahj ~R# (a_ahj -> a_ahj)))
(ds_dhx
`cast` (Endo.N:Endo[0] <a_ahj>_R
:: Endo a_ahj ~R# (a_ahj -> a_ahj))))
`cast` (Sym (Endo.N:Endo[0] <a_ahj>_R)
:: (a_ahj -> a_ahj) ~R# Endo a_ahj)
-- RHS size: {terms: 9, types: 8, coercions: 0, joins: 0/0}
comp [InlPrag=OPAQUE]
:: forall b c a. (b -> c) -> (a -> b) -> a -> c
[LclIdX,
Arity=3,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)}]
comp
= \ (@b_ahm)
(@c_ahn)
(@a_aho)
(f_at :: b_ahm -> c_ahn)
(g_au :: a_aho -> b_ahm)
(x_av :: a_aho) ->
f_at (g_au x_av)
-- RHS size: {terms: 6, types: 8, coercions: 4, joins: 0/0}
foo_si3 :: forall {a}. Endo a -> Endo a -> a -> a
[LclId,
Arity=3,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
foo_si3
= \ (@a_ahr) (ds_dhX :: Endo a_ahr) (ds_dhY :: Endo a_ahr) ->
comp
@a_ahr
@a_ahr
@a_ahr
(ds_dhX
`cast` (Endo.N:Endo[0] <a_ahr>_R
:: Endo a_ahr ~R# (a_ahr -> a_ahr)))
(ds_dhY
`cast` (Endo.N:Endo[0] <a_ahr>_R
:: Endo a_ahr ~R# (a_ahr -> a_ahr)))
-- RHS size: {terms: 1, types: 0, coercions: 13, joins: 0/0}
foo :: forall a. Endo a -> Endo a -> Endo a
[LclIdX,
Arity=3,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
foo
= foo_si3
`cast` (forall (a :: <*>_N).
<Endo a>_R
%<'Many>_N ->_R <Endo a>_R
%<'Many>_N ->_R Sym (Endo.N:Endo[0] <a>_R)
:: (forall {a}. Endo a -> Endo a -> a -> a)
~R# (forall {a}. Endo a -> Endo a -> Endo a))