#3822: guards in arrow notation (Arrows extension) case statement cause compiler
panic
-----------------------------------------+----------------------------------
Reporter: StephenBlackheath | Owner: ross
Type: bug | Status: new
Priority: normal | Milestone: 6.12.2
Component: Compiler | Version: 6.12.1
Keywords: arrows guards case panic | Difficulty:
Os: Unknown/Multiple | Testcase: patternGuard.hs
Architecture: Unknown/Multiple | Failure: Compile-time crash
-----------------------------------------+----------------------------------
Comment(by simonpj):
Slightly smaller test case
{{{
{-# LANGUAGE Arrows #-}
module T3822 where
import Control.Arrow
test :: Int -> Int
test = proc x -> do
let neg = x < 0
case x of
x | neg -> returnA -< 0 -- GHC panics
_ -> returnA -< 10
}}}
Ross: can you see what is wrong? Core Lint gives the error below after
desugaring:
{{{
*** Core Lint errors : in result of Desugar ***
<no location info>:
[in body of letrec with binders fail_dnE :: GHC.Prim.State#
GHC.Prim.RealWorld
-> Data.Either.Either ()
()]
neg_acJ is out of scope
*** Offending Program ***
Rec {
T3822.test :: GHC.Types.Int -> GHC.Types.Int
[LclIdX]
T3822.test =
>>>_aiG
@ GHC.Types.Int
@ GHC.Types.Int
@ GHC.Types.Int
(arr_aix
@ GHC.Types.Int
@ GHC.Types.Int
(\ (x_acI :: GHC.Types.Int) -> x_acI))
(>>>_aiG
@ GHC.Types.Int
@ GHC.Types.Int
@ GHC.Types.Int
(arr_aix
@ GHC.Types.Int
@ GHC.Types.Int
(\ (ds_dnJ :: GHC.Types.Int) ->
let {
x_acI :: GHC.Types.Int
[LclId]
x_acI = ds_dnJ } in
letrec {
neg_acJ :: GHC.Bool.Bool
[LclId]
neg_acJ = <_ai2 x_acI (GHC.Types.I# 0);
neg_ai3 :: GHC.Bool.Bool
[LclId]
neg_ai3 = neg_acJ; } in
x_acI))
(>>>_aiG
@ GHC.Types.Int
@ (Data.Either.Either () ())
@ GHC.Types.Int
(arr_aix
@ GHC.Types.Int
@ (Data.Either.Either () ())
(\ (ds_dnH :: GHC.Types.Int) ->
let {
x_acI :: GHC.Types.Int
[LclId]
x_acI = ds_dnH } in
let {
x_ahI :: GHC.Types.Int
[LclId]
x_ahI = x_acI } in
let {
fail_dnE
:: GHC.Prim.State# GHC.Prim.RealWorld ->
Data.Either.Either () ()
[LclId]
fail_dnE =
\ (ds_dnF :: GHC.Prim.State# GHC.Prim.RealWorld) ->
Data.Either.Right @ () @ () GHC.Unit.() } in
case neg_acJ of wild_B1 {
GHC.Bool.False -> fail_dnE GHC.Prim.realWorld#;
GHC.Bool.True -> Data.Either.Left @ () @ () GHC.Unit.()
}))
(|||_aiK
@ ()
@ GHC.Types.Int
@ ()
(>>>_aiG
@ ()
@ GHC.Types.Int
@ GHC.Types.Int
(arr_aix
@ ()
@ GHC.Types.Int
(\ (ds_dnB :: ()) ->
case ds_dnB of ds_dnB { () -> GHC.Types.I# 0 }))
returnA_aig)
(>>>_aiG
@ ()
@ GHC.Types.Int
@ GHC.Types.Int
(arr_aix
@ ()
@ GHC.Types.Int
(\ (ds_dnD :: ()) ->
case ds_dnD of ds_dnD { () -> GHC.Types.I# 10 }))
returnA_ain))))
|||_aiK
:: forall b_ami d_amj c_amk.
(b_ami -> d_amj)
-> (c_amk -> d_amj)
-> Data.Either.Either b_ami c_amk
-> d_amj
[LclId]
|||_aiK = Control.Arrow.||| @ (->) $dArrowChoice_anx
$dArrow_anw :: Control.Arrow.Arrow (->)
[LclId]
$dArrow_anw = $dArrow_anq
first_aiH
:: forall b_aiN c_aiO d_aiP.
(b_aiN -> c_aiO) -> (b_aiN, d_aiP) -> (c_aiO, d_aiP)
[LclId]
first_aiH = Control.Arrow.first @ (->) $dArrow_anw
$dArrow_anv :: Control.Arrow.Arrow (->)
[LclId]
$dArrow_anv = $dArrow_anq
>>>_aiG
:: forall a_aiD b_aiE c_aiF.
(a_aiD -> b_aiE) -> (b_aiE -> c_aiF) -> a_aiD -> c_aiF
[LclId]
>>>_aiG = GHC.Desugar.>>> @ (->) $dArrow_anv
$dArrow_anu :: Control.Arrow.Arrow (->)
[LclId]
$dArrow_anu = $dArrow_anq
arr_aix :: forall b_aiL c_aiM. (b_aiL -> c_aiM) -> b_aiL -> c_aiM
[LclId]
arr_aix = Control.Arrow.arr @ (->) $dArrow_anu
returnA_ain :: GHC.Types.Int -> GHC.Types.Int
[LclId]
returnA_ain = returnA_aig
$dArrowChoice_anx :: Control.Arrow.ArrowChoice (->)
[LclId]
$dArrowChoice_anx = Control.Arrow.$fArrowChoice(->)
$dArrow_anq :: Control.Arrow.Arrow (->)
[LclId]
$dArrow_anq = Control.Arrow.$p1ArrowChoice @ (->) $dArrowChoice_anx
returnA_aig :: GHC.Types.Int -> GHC.Types.Int
[LclId]
returnA_aig =
Control.Arrow.returnA @ (->) @ GHC.Types.Int $dArrow_anq
lit_aip :: GHC.Types.Int
[LclId]
lit_aip = GHC.Types.I# 10
lit_aii :: GHC.Types.Int
[LclId]
lit_aii = GHC.Types.I# 0
$dOrd_ano :: GHC.Classes.Ord GHC.Types.Int
[LclId]
$dOrd_ano = GHC.Base.$fOrdInt
<_ai2 :: GHC.Types.Int -> GHC.Types.Int -> GHC.Bool.Bool
[LclId]
<_ai2 = GHC.Classes.< @ GHC.Types.Int $dOrd_ano
test_ahS :: GHC.Types.Int -> GHC.Types.Int
[LclId]
test_ahS = T3822.test
end Rec }
*** End of Offense ***
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/3822#comment:7>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
