problem presenting with explicit pattern matching

Hi all,

I believe I've found a bug in ghc 6.6.1.

From Chapter 9. What to do when something goes wrong

“I think GHC is producing incorrect code”:

Unlikely :-)

And yet I'm out of ideas on why my code is acting the way it does. I've got a tiny program for the towers of hanoi. In my step function moving one disk to the next peg I seem to be hitting a bug for explicit pattern matching. I have a small example file (included below) to detail the issue.

1. What kind of machine am I running on?

$ uname -a
Linux lanny-lnx 2.4.21-32.0.1.EL #1 Tue May 17 18:01:37 EDT 2005 i686 i686 i386 GNU/Linux

I have also reproduced the bug (using ghc 6.6.1) on a Mac OS X system. My linux box uses the rpm install from haskell.org/ghc but on the mac I built ghc from the ground up (via http://darwinports.com).

1. What version of gcc am I using?

$ gcc -v
Reading specs from /usr/lib/gcc-lib/i386-redhat-linux/3.2.3/specs
Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --enable-shared --enable-threads=posix --disable-checking --with-system-zlib --enable-__cxa_atexit --host=i386-redhat-linux
Thread model: posix
gcc version 3.2.3 20030502 (Red Hat Linux 3.2.3-52)

The mac is using the latest Xcode so it's got gcc 4.0.x

1. Complete ghci -v run showing problem.

$ ghci -v hanoi_bug.hs
   ___         ___ _
  / _ \ /\  /\/ __(_)
 / /_\// /_/ / /  | |      GHC Interactive, version 6.6.1, for Haskell 98.
/ /_\\/ __  / /___| |      http://www.haskell.org/ghc/
\____/\/ /_/\____/|_|      Type :? for help.

Using package config file: /opt/ghc-6.6.1/lib/i386-unknown-linux/package.conf
wired-in package base mapped to base-2.1.1
wired-in package rts mapped to rts-1.0
wired-in package haskell98 mapped to haskell98-1.0
wired-in package template-haskell mapped to template-haskell-2.1
Hsc static flags: -static
Loading package base ... linking ... done.
wired-in package base mapped to base-2.1.1
wired-in package rts mapped to rts-1.0
wired-in package haskell98 mapped to haskell98-1.0
wired-in package template-haskell mapped to template-haskell-2.1
*** Parser:
*** Desugar:
*** Simplify:
*** CorePrep:
*** ByteCodeGen:
*** Parser:
*** Desugar:
*** Simplify:
*** CorePrep:
*** ByteCodeGen:
wired-in package base mapped to base-2.1.1
wired-in package rts mapped to rts-1.0
wired-in package haskell98 mapped to haskell98-1.0
wired-in package template-haskell mapped to template-haskell-2.1
*** Chasing dependencies:
Stable obj: []
Stable BCO: []
unload: retaining objs []
unload: retaining bcos []
Upsweep completely successful.
*** Deleting temp files:
Deleting: 
*** Chasing dependencies:
Stable obj: []
Stable BCO: []
unload: retaining objs []
unload: retaining bcos []
compile: input file hanoi_bug.hs
*** Checking old interface for main:Main:
[1 of 1] Compiling Main             ( hanoi_bug.hs, interpreted )
*** Parser:
*** Renamer/typechecker:
*** Desugar:
    Result size = 1076
*** Simplify:
    Result size = 1523
    Result size = 1323
    Result size = 1323
*** Tidy Core:
    Result size = 1323
*** CorePrep:
    Result size = 1641
*** ByteCodeGen:
*** Deleting temp files:
Deleting: 
Upsweep completely successful.
*** Deleting temp files:
Deleting: 
Ok, modules loaded: Main.
*Main> main
*** Parser:
*** Desugar:
*** Simplify:
*** CorePrep:
*** ByteCodeGen:
[True,True,True,False,False,True]
*Main> :q
Leaving GHCi.
*** Deleting temp files:
Deleting: 
*** Deleting temp dirs:
Deleting: 

1. What program behavior is wrong?

main is recording a list of properties which should all return True.

The behavior is the same for compiled rather than interpreted code on both the linux and mac systems.

1. Source code demonstrating the problem.

$ cat hanoi_bug.hs
-- A Task is a tuple of
--      n :: The number of disks to move
--      i :: The initial peg
--      a :: The auxillary peg
--      f :: The final peg
type Task = (Int, Int, Int, Int)

data Tower a = Tower a a a
        deriving (Eq, Show)

peg :: Int -> Tower [a] -> [a]
peg 1 (Tower a b c) = a
peg 2 (Tower a b c) = b
peg 3 (Tower a b c) = c

mkTower :: Task -> [a] -> [a] -> [a] -> Tower [a]
mkTower (_,1,2,3) a b c = Tower a b c
mkTower (_,1,3,2) a b c = Tower a c b
mkTower (_,2,1,3) a b c = Tower b a c
mkTower (_,2,3,1) a b c = Tower b c a   -- BUG!  returns (Tower c a b)
mkTower (_,3,1,2) a b c = Tower c a b   -- BUG!  returns (Tower b c a)
mkTower (_,3,2,1) a b c = Tower c b a

step :: Task -> Tower [a] -> Tower [a]
step task@(_,i,a,f) tower =
        let pi    = peg i tower
            pa    = peg a tower
            pf    = peg f tower
        in
                mkTower task (tail pi) pa (head pi : pf)

prop_test123 = step (1,1,2,3) (Tower [1] [3] [2]) == Tower []    [3]   [1,2]
prop_test132 = step (1,1,3,2) (Tower [1] [2] [3]) == Tower []    [1,2] [3]
prop_test213 = step (1,2,1,3) (Tower [3] [1] [2]) == Tower [3]   []    [1,2]
prop_test231 = step (1,2,3,1) (Tower [2] [1] [3]) == Tower [1,2] []    [3]
prop_test312 = step (1,3,1,2) (Tower [3] [2] [1]) == Tower [3]   [1,2] []
prop_test321 = step (1,3,2,1) (Tower [2] [3] [1]) == Tower [1,2] [3]   []

checkProps = [ prop_test123
             , prop_test132
             , prop_test213
             , prop_test231
             , prop_test312
             , prop_test321
             ]

main :: IO ()
main = print checkProps

1. If you are a hero...

Sorry. Not yet. At a guess the book-keeping for explicit pattern matches is getting mixed up. Note that mkTower does provide the correct permutations, it's just that two of them are mixed up.

Trac metadata

Trac field	Value
Version	6.6.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture