#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