[GHC] #11224: Program doesn't preserve semantics after pattern synonym inlining.
GHC
ghc-devs at haskell.org
Tue Dec 15 19:55:43 UTC 2015
#11224: Program doesn't preserve semantics after pattern synonym inlining.
-------------------------------------+-------------------------------------
Reporter: anton.dubovik | Owner:
Type: bug | Status: new
Priority: highest | Milestone: 8.0.1
Component: Compiler | Version: 7.10.2
Resolution: | Keywords:
| PatternSynonyms
Operating System: Windows | Architecture: x86_64
Type of failure: Incorrect result | (amd64)
at runtime | Test Case:
Blocked By: | Blocking:
Related Tickets: #11225 | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by mpickering):
The original report triggers a core lint error.
{{{
*** Core Lint errors : in result of Desugar (before optimization) ***
T11224.hs:12:12: warning:
[RHS of xs_aqv :: [Int]]
The type of this binder doesn't match the type of its RHS: xs_aqv
Binder's type: [Int]
Rhs type: Int
*** Offending Program ***
Rec {
$dRead_a2FJ :: Read Int
[LclId, Str=DmdType]
$dRead_a2FJ = $dRead_a148
$dRead_a2FO :: Read [Int]
[LclId, Str=DmdType]
$dRead_a2FO = $dRead_a14j
$dRead_a14j :: Read [Int]
[LclId, Str=DmdType]
$dRead_a14j = $fRead[] @ Int $dRead_a148
$dRead_a148 :: Read Int
[LclId, Str=DmdType]
$dRead_a148 = $fReadInt
$dFoldable_a2FR :: Foldable []
[LclId, Str=DmdType]
$dFoldable_a2FR = $dFoldable_a21o
$dFoldable_a21o :: Foldable []
[LclId, Str=DmdType]
$dFoldable_a21o = $fFoldable[]
$dNum_a2FV :: Num Int
[LclId, Str=DmdType]
$dNum_a2FV = $dNum_a2aM
$dNum_a2aM :: Num Int
[LclId, Str=DmdType]
$dNum_a2aM = $fNumInt
$dMonad_a2QC :: Monad IO
[LclId, Str=DmdType]
$dMonad_a2QC = $dMonad_a2Gj
$dMonad_a2Ql :: Monad IO
[LclId, Str=DmdType]
$dMonad_a2Ql = $dMonad_a2Gj
$dMonad_a2Q4 :: Monad IO
[LclId, Str=DmdType]
$dMonad_a2Q4 = $dMonad_a2Gj
$dMonad_a2PN :: Monad IO
[LclId, Str=DmdType]
$dMonad_a2PN = $dMonad_a2Gj
$dMonad_a2Gj :: Monad IO
[LclId, Str=DmdType]
$dMonad_a2Gj = $fMonadIO
$dShow_a2QT :: Show Int
[LclId, Str=DmdType]
$dShow_a2QT = $dShow_a2PG
$dShow_a2QM :: Show Int
[LclId, Str=DmdType]
$dShow_a2QM = $dShow_a2PG
$dShow_a2Qv :: Show Int
[LclId, Str=DmdType]
$dShow_a2Qv = $dShow_a2PG
$dShow_a2Qe :: Show Int
[LclId, Str=DmdType]
$dShow_a2Qe = $dShow_a2PG
$dShow_a2PX :: Show Int
[LclId, Str=DmdType]
$dShow_a2PX = $dShow_a2PG
$dShow_a2PG :: Show Int
[LclId, Str=DmdType]
$dShow_a2PG = $fShowInt
bar :: String -> Int
[LclId, Str=DmdType]
bar =
letrec {
bar_aLd :: String -> Int
[LclId, Str=DmdType]
bar_aLd =
\ (ds_d3jj :: String) ->
let {
fail_d3kF :: Void# -> Int
[LclId, Str=DmdType]
fail_d3kF =
\ (ds_d3kG [OS=OneShot] :: Void#) ->
let {
fail_d3kD :: Void# -> Int
[LclId, Str=DmdType]
fail_d3kD = \ (ds_d3kE [OS=OneShot] :: Void#) -> I# 666# }
in
let {
ds_d3kC :: Maybe [Int]
[LclId, Str=DmdType]
ds_d3kC = readMaybe @ [Int] $dRead_a14j ds_d3jj } in
case ds_d3kC of wild_00 {
__DEFAULT -> fail_d3kD void#;
Just xs_azI -> sum @ [] $dFoldable_a21o @ Int $dNum_a2aM
xs_azI
} } in
let {
ds_d3kB :: Maybe Int
[LclId, Str=DmdType]
ds_d3kB = readMaybe @ Int $dRead_a148 ds_d3jj } in
case ds_d3kB of wild_00 {
__DEFAULT -> fail_d3kF void#;
Just x_azH -> x_azH
}; } in
bar_aLd
$mPRead
:: forall (rlev_a2FC :: Levity) (r_a2FD :: TYPE rlev_a2FC) a_a2aV.
Read a_a2aV =>
String -> (a_a2aV -> r_a2FD) -> (Void# -> r_a2FD) -> r_a2FD
[LclIdX[PatSynId], Str=DmdType]
$mPRead =
\ (@ (rlev_a2FC :: Levity))
(@ (r_a2FD :: TYPE rlev_a2FC))
(@ a_a2aV)
($dRead_a2FB :: Read a_a2aV)
(scrut_a2FE :: String)
(cont_a2FF :: a_a2aV -> r_a2FD)
(fail_a2FG :: Void# -> r_a2FD) ->
let {
$dRead_a2aX :: Read a_a2aV
[LclId, Str=DmdType]
$dRead_a2aX = $dRead_a2FB } in
let {
ds_d3kH :: String
[LclId, Str=DmdType]
ds_d3kH = scrut_a2FE } in
let {
fail_d3kL :: Void# -> r_a2FD
[LclId, Str=DmdType]
fail_d3kL =
\ (ds_d3kM [OS=OneShot] :: Void#) -> fail_a2FG void# } in
let {
ds_d3kK :: Maybe a_a2aV
[LclId, Str=DmdType]
ds_d3kK = readMaybe @ a_a2aV $dRead_a2aX ds_d3kH } in
case ds_d3kK of wild_00 {
__DEFAULT -> fail_d3kL void#;
Just a_aqt -> cont_a2FF a_aqt
}
foo :: String -> Int
[LclId, Str=DmdType]
foo =
letrec {
foo_a2FH :: String -> Int
[LclId, Str=DmdType]
foo_a2FH =
\ (ds_d3kN :: String) ->
let {
fail_d3m5 :: Void# -> Int
[LclId, Str=DmdType]
fail_d3m5 = \ (ds_d3m6 [OS=OneShot] :: Void#) -> I# 666# } in
$mPRead
@ 'Lifted
@ Int
@ Int
$dRead_a2FJ
ds_d3kN
(\ (x_aqu :: Int) ->
let {
xs_aqv :: [Int]
[LclId, Str=DmdType]
xs_aqv = x_aqu } in
x_aqu)
(\ (void_0E :: Void#) -> fail_d3m5 void#); } in
foo_a2FH
main :: IO ()
[LclIdX, Str=DmdType]
main =
letrec {
main_a2G0 :: IO ()
[LclId, Str=DmdType]
main_a2G0 =
>>
@ IO
$dMonad_a2Gj
@ ()
@ ()
($ @ 'Lifted
@ Int
@ (IO ())
(print @ Int $dShow_a2PG)
(foo (unpackCString# "1"#)))
(>>
@ IO
$dMonad_a2PN
@ ()
@ ()
($ @ 'Lifted
@ Int
@ (IO ())
(print @ Int $dShow_a2PX)
(foo (unpackCString# "[1,2,3]"#)))
(>>
@ IO
$dMonad_a2Q4
@ ()
@ ()
($ @ 'Lifted
@ Int
@ (IO ())
(print @ Int $dShow_a2Qe)
(foo (unpackCString# "xxx"#)))
(>>
@ IO
$dMonad_a2Ql
@ ()
@ ()
($ @ 'Lifted
@ Int
@ (IO ())
(print @ Int $dShow_a2Qv)
(bar (unpackCString# "1"#)))
(>>
@ IO
$dMonad_a2QC
@ ()
@ ()
($ @ 'Lifted
@ Int
@ (IO ())
(print @ Int $dShow_a2QM)
(bar (unpackCString# "[1,2,3]"#)))
($ @ 'Lifted
@ Int
@ (IO ())
(print @ Int $dShow_a2QT)
(bar (unpackCString# "xxx"#))))))); } in
main_a2G0
$trModule :: Module
[LclIdX[ReflectionId], Str=DmdType]
$trModule = Module (TrNameS "main"#) (TrNameS "Main"#)
main :: IO ()
[LclIdX, Str=DmdType]
main = runMainIO @ () main
end Rec }
*** End of Offense ***
}}}
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11224#comment:14>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list