Opened 10 years ago

Closed 9 years ago

#3822 closed bug (fixed)

guards in arrow notation (Arrows extension) case statement cause compiler panic

Reported by: StephenBlackheath Owned by: ross
Priority: high Milestone: 7.0.1
Component: Compiler Version: 6.12.1
Keywords: arrows guards case panic Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: Compile-time crash Test Case: T3822
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:

Description (last modified by igloo)

The attached test case causes this panic message:

ghc: panic! (the 'impossible' happened)
  (GHC version 6.12.1 for x86_64-unknown-linux):
	initC: srt_lbl

Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug

The offending line is the one with '| neg'. It doesn't panic if you use the commented out line below it instead.

This kind of case statement is specific to arrow notation (provided by the Arrows extension) - the compiler uses ArrowChoice to implement it.

Change History (12)

comment:1 Changed 10 years ago by StephenBlackheath

Trac won't let me attach files (OSError: [Errno 13] Permission denied: '/srv/trac/ghc/attachments/ticket/3822'), so here's the test case in a comment. Command line is

ghc patternGuard.hs --make


{-# LANGUAGE Arrows #-}

import Control.Arrow import qualified Control.Category as Cat

test :: Int -> Int test = proc x -> do

let neg = x < 0 case x of

x | neg -> returnA -< 0 -- GHC panics --x | x < 0 -> returnA -< 0 -- GHC doesn't panic _ -> returnA -< 10

main = do

print $ test (-1) print $ test 1

comment:2 Changed 10 years ago by StephenBlackheath

{-# LANGUAGE Arrows #-}

import Control.Arrow
import qualified Control.Category as Cat

test :: Int -> Int
test = proc x -> do
    let neg = x < 0
    case x of
        x | neg -> returnA -< 0           -- GHC panics
        --x | x < 0 -> returnA -< 0       -- GHC doesn't panic
        _       -> returnA -< 10

main = do
    print $ test (-1)
    print $ test 1

comment:3 Changed 10 years ago by ross

Owner: set to ross

Lovely report. (This is an ordinary guard, rather than a pattern guard.)

comment:4 Changed 10 years ago by ross

Architecture: x86_64 (amd64)Unknown/Multiple
Keywords: pattern removed
Operating System: LinuxUnknown/Multiple
Summary: pattern guards in arrow notation (Arrows extension) case statement cause compiler panicguards in arrow notation (Arrows extension) case statement cause compiler panic

comment:5 Changed 10 years ago by igloo

Description: modified (diff)

comment:6 Changed 10 years ago by igloo

Milestone: 6.12.2

comment:7 Changed 10 years ago 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 ***

comment:8 in reply to:  7 Changed 10 years ago by ross

Replying to simonpj:

Ross: can you see what is wrong? Core Lint gives the error below after desugaring:

Yes, variables occurring only in guards are not being recognized as being used, so they're discarded from the pipeline before reaching the case.

comment:9 Changed 9 years ago by igloo

Milestone: 6.12.26.12.3
Priority: normalhigh

comment:10 Changed 9 years ago by simonmar

Ross: sorry for the delay in getting back to you. Which bit of code is responsible for recognising variables as being used? Is it arrows-specific, or somewhere else? Can you help us fix it? (Cheers, Simon & Simon)

comment:11 Changed 9 years ago by ross

Status: newmerge

I believe this is fixed by

Tue Jun 15 15:51:10 PDT 2010  Ross Paterson <ross at soi.city.ac.uk>
  * fix #3822: desugaring case command in arrow notation

comment:12 Changed 9 years ago by igloo

Milestone: 6.12.36.14.1
Resolution: fixed
Status: mergeclosed
Test Case: patternGuard.hsT3822

Thanks! Test added.

Not merging, as we won't be making another 6.12 release.

Note: See TracTickets for help on using tickets.